AHIPAS04        ;NC/RLP Compute LOS for each Patient on every Ward   18-Oct-02
        ;v1.0
        ;
        ;
DEV     K IO("Q") S %ZIS("B")="NETSERVER" D ^%ZIS I POP G EXIT
        U IO
        ;
        W !!!,"NEED TO ADD nsc/sc INFO instead of just having the SC%",!!!
        Q
EN1     S BgnDate=3011001         ; --- Begin of FY02
        S EndDate=3020930         ; --- End of FY02
        S Count=0                 ; --- Primary Key for MS Access
        ;
        S DFN=0
        F  S DFN=$O(^DGPT("B",DFN)) Q:'DFN  D  ;
        . S IEN=0
        . F  S IEN=$O(^DGPT("B",DFN,IEN)) Q:'IEN  D  ;
        . . ;
        . . ; --- Get the 0 node & 70 node for the PTF record
A       . . S PTF0=$G(^DGPT(IEN,0))
        . . S PTF70=$G(^DGPT(IEN,70))
        . . ;
        . . ; --- Screen out Fee Basis & Census records
SCRN    . . S FeeBasis=+$P(PTF0,U,4) I FeeBasis=1 Q
        . . S TypRcrd=+$P(PTF0,U,11) I TypRcrd'=1 Q
        . . ;
        . . S AdmtDt=$P($P(PTF0,U,2),".",1)
        . . S DschDt=$P($P(PTF70,U,1),".",1)
        . . ;
        . . ; --- Verify record falls within Date Range
B       . . I DschDt]"",DschDt<BgnDate Q
        . . I AdmtDt>EndDate Q
        . . ;
        . . ; --- Get Patient Information
PAT     . . D DEM^VADPT S PatName=VADM(1),SSN=VADM(2)
        . . D ELIG^VADPT S SC=$P(VAEL(3),"^",2) I SC']"" S SC=0
        . . D ADD^VADPT S Zip=VAPA(6),County=$P(VAPA(7),U,2)
        . . ;
        . . ; --- Loop thru the Physical Movements in the PTF record
        . . ; --- First (FstMvDt) & Second (SndMvDt) updated for each change
MAIN    . . S FstMvDt=AdmtDt
        . . S PhyMv=0,ScndTime=0,HsptlWrd=0
        . . S WardLTC=0,WardHspt=0
        . . ;
        . . F  S PhyMv=$O(^DGPT(IEN,535,PhyMv)) Q:'PhyMv  D  S FstMvDt=SndMvDt,S
cndTime=1
        . . . I ScndTime=1,FstMvDt=EndDate Q
        . . . S PTF535=^DGPT(IEN,535,PhyMv,0)
        . . . S SndMvDt=$P($P(PTF535,U,10),".",1)
        . . . I SndMvDt]"",SndMvDt<BgnDate Q
        . . . I SndMvDt]"",SndMvDt>EndDate S SndMvDt=EndDate
        . . . I FstMvDt<BgnDate S FstMvDt=BgnDate
        . . . I SndMvDt']"" S SndMvDt=EndDate
        . . . S LOS=$$FMDIFF^XLFDT(SndMvDt,FstMvDt,1)
        . . . I LOS=0 S LOS=1
        . . . ;
WARDS   . . . S ILsngWrd=$P(PTF535,U,6)
        . . . S XLsngWrd=$P($G(^DIC(42,ILsngWrd,0)),U,1)
        . . . S LsngWard="^"_ILsngWrd_"^"
        . . . ;
        . . . ; --- LTC areas 1st: NHCU  2nd: Dom  3rd: PRRTP
LTC     . . . I "^104^251^252^224^108^249^101^102^80^87^79^86^"[LsngWard S WardL
TC=1,WardHspt=0
        . . . I "^62^97^247^233^234^"[LsngWard S WardLTC=1,WardHspt=0
        . . . I "^237^235^"[LsngWard S WardLTC=1,WardHspt=0
        . . . ;
        . . . ; --- hospital areas 1st: Psych  2nd: Gen Med  3rd: Observation
HSP     . . . I "^53^54^232^95^51^106^231^"[LsngWard S WardHspt=1,WardLTC=0
        . . . I "^236^65^66^"[LsngWard S WardHspt=1,WardLTC=0
        . . . I "^242^243^245^239^238^248^246^244^"[LsngWard S WardHspt=1,WardLT
C=0
        . . . ;
        . . . ; --- Review/Troubleshoot if Flag is 0 - This status is OK!
        . . . ; ---                                1 - Why are both wards set?
        . . . ; ---                                2 - Ward not identified!
FLAG    . . . S Flag=0
        . . . I WardLTC,WardHspt S Flag=1 S (WardLTC,WardHspt)=0
        . . . I 'Flag,'WardLTC,'WardHspt S Flag=2
        . . . ;
        . . . S XFstMvDt=$$ENTRY^RGUTDT(FstMvDt,0000)
        . . . S XSndMvDt=$$ENTRY^RGUTDT(SndMvDt,0000)
        . . . S Count=Count+1
        . . . ;
        . . . W !,Count,U,TypRcrd,U,IEN,U,PhyMv,U,DFN,U,PatName,U,SSN,U
        . . . W Zip,U,County,U,SC,U,XLsngWrd,U,LOS,U,XFstMvDt,U,XSndMvDt,U
        . . . W Flag,U
        ;
EXIT    D ^%ZISC
        K AdmtDt,BgnDate,Count,County,DFN,DschDt,EndDate,Flag,FeeBasis
        K FstMvDt,IEN,ILsngWrd,LOS,LsngWard,POP,PTF0,PTF535,PTF70,PatName
        K PhyMv,SC,SSN,SndMvDt,ScndTime,TypRcrd,VADM,VAEL,VAPA,WardHspt
        K WardLTC,XFstMvDt,XLsngWrd,XSndMvDt,Zip
        Q