- IVMUFNC1 ;ALB/SEK - INPATIENT/OUTPATIENT CALCULATIONS ; 06/19/2003
- ;;2.0;INCOME VERIFICATION MATCH ;**3,11,80**; 21-OCT-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- EN(DFN,IVMMTDT,IVMQUERY) ; number of inpatient and outpatient days since IVMMTDT date to
- ; IVMENDT (earliest of day before next means test and day before current date).
- ; Input: DFN -- pointer to patient in file #2
- ; IVMMTDT -- Means Test date/time for the patient
- ; IVMQUERY("OVIS") -- # of the QUERY that is currently open or
- ; undefined, zero, or null if no QUERY opened for
- ; finding outpatient visits
- ; Output: 1^2 where piece 1 = # of inpatient days
- ; piece 2 = # of outpatient days
- ;
- N IVMAD,IVMADMDT,IVMD,IVMDCN,IVMDT,IVMDGPM,IVMDISDT,IVMENDT,IVMF,IVMI,IVMIN,IVMOUT
- N IVMASIH,IVMADPTR,IVMDATE,VAINDT,VADMVT,VAIP,VAERR
- ;
- S (IVMIN,IVMOUT)=0
- I '$G(IVMMTDT) G EPQ
- S IVMMTDT=$P($$LST^DGMTU(DFN,IVMMTDT),"^",2)
- I '$G(IVMMTDT) G EPQ
- S IVMMTDT=$P(IVMMTDT,".")
- K ^TMP($J,"IVMUFNC1")
- ;
- ; - quit if the effective date of the test is today
- I IVMMTDT=DT G EPQ
- ;
- ; Calculate number of inpatient days
- ;
- ; get end date
- S IVMENDT=$$END^IVMUFNC2(DFN,IVMMTDT)
- ;
- ; - find if patient was an inpatient on IVMMTDT
- S VAINDT=IVMMTDT D ADM^VADPT2
- I VADMVT S IVMASIH=$P($G(^DGPM(VADMVT,0)),"^",21) D
- .I IVMASIH D Q
- ..S IVMIN=IVMIN+$$LOS(VADMVT,IVMMTDT)
- ..S IVMADPTR=$P($G(^DGPM(IVMASIH,0)),"^",14)
- ..S IVMDATE=$$CHK(IVMADPTR,IVMMTDT)
- ..S IVMIN=IVMIN+$$LOS(IVMADPTR,IVMDATE)
- .S VAIP("D")=IVMMTDT D IN5^VADPT
- .I 'VAIP(10) S IVMDATE=$$CHK(VADMVT,IVMMTDT)
- .S IVMIN=IVMIN+$$LOS(VADMVT,$S('VAIP(10):IVMDATE,1:IVMMTDT))
- ;
- ; - find admissions after IVMMTDT to end date
- S IVMD="" F S IVMD=$O(^DGPM("ATID1",DFN,IVMD)) Q:'IVMD!(9999999.9999999-IVMD<IVMMTDT) I 9999999.9999999-IVMD'>IVMENDT S IVMIN=IVMIN+$$LOS(+$O(^(IVMD,0)))
- ;
- ; Calculate number of outpatient days
- ;
- D EN^IVMUFNC2(.IVMQUERY)
- ;
- EPQ K ^TMP($J,"IVMUFNC1")
- Q IVMIN_"^"_IVMOUT
- ;
- ;
- LOS(IVMDG,IVMST) ; Calculate the length of stay for an admission.
- ; Input: IVMDG -- Pointer to the admission in file #405
- ; IVMST -- [Optional] Date after the admission on
- ; which to begin calculation of the LOS.
- ; Output: X -- Length of stay (in days)
- ;
- N A,D,DFN,DGE,DGS,I,X,X1,X2,LOP,LOA,LOAS,LOS
- S (LOP,LOA,LOAS)=0
- I $S('$D(IVMDG):1,'$D(^DGPM(+IVMDG,0)):1,$P(^(0),"^",2)'=1:1,1:0) S X=0 G Q
- S X=^DGPM(+IVMDG,0),DFN=$P(^(0),"^",3),(X2,A)=+X,D=$S($D(^DGPM(+$P(X,"^",17),0)):+^(0),1:""),(X1,D)=$S('D:IVMENDT,D>IVMENDT:IVMENDT,1:D)
- I $G(IVMST)'<$P(D,".") S X=0 G Q
- S:$G(IVMST) (X2,A)=IVMST
- D ^%DTC S LOS=$S(X:X,1:1) ; LOS = elapsed time between admission and discharge (or end date)
- F I=A:0 S I=$O(^DGPM("APCA",DFN,IVMDG,I)) Q:'I S DGS=$O(^(I,0)) I $D(^DGPM(+DGS,0)) S DGS=^(0) Q:+DGS>IVMENDT I "^1^2^3^13^43^44^45^"[("^"_$P(DGS,"^",18)_"^") S X2=+DGS,DGS=$P(DGS,"^",18) D ABS Q:'I
- S X=LOS-LOA-LOAS
- Q Q X
- ;
- ABS ; If patient was out on absence, find return
- S X1=0 F I=I:0 S I=$O(^DGPM("APCA",DFN,IVMDG,I)) Q:'I S DGE=$O(^(I,0)) I $D(^DGPM(+DGE,0)) S DGE=^(0) I "^14^22^23^24^"[("^"_$P(DGE,"^",18)_"^") S X1=+DGE,DGE=$P(DGE,"^",18) Q
- ; if no return from absence, use discharge or end date
- ; if return from absence greater then end date use end date
- I 'X1!(X1>D) S X1=D
- D ^%DTC S X=$S(X:X,1:1) I DGS=1,$S('$D(DGE):1,DGE'=25:1,1:0) S LOP=LOP+X Q ;if TO AA <96, but not FROM AA<96, count as absence, not pass
- I "^1^2^3^25^26^"[("^"_DGS_"^") S LOA=LOA+X Q
- S LOAS=LOAS+X Q
- ;
- CHK(ADPTR,DATE) ; Determine date that patient returned from leave
- ; Input: ADPTR -- Pointer to admission in file #405
- ; DATE -- Date the patient was on leave or ASIH
- ; Output: X1 -- Date the patient returned from leave
- N X,Y,I,%,X1,X2,DIS,DGE
- S X=^DGPM(+ADPTR,0),DIS=$S($D(^DGPM(+$P(X,"^",17),0)):+^(0),1:""),DIS=$S('DIS:IVMENDT,DIS>IVMENDT:IVMENDT,1:DIS)
- S X1=0 F I=DATE:0 S I=$O(^DGPM("APCA",DFN,ADPTR,I)) Q:'I S DGE=$O(^(I,0)) I $D(^DGPM(+DGE,0)) S DGE=^(0) I "^14^22^23^24^"[("^"_$P(DGE,"^",18)_"^") S X1=+DGE Q
- Q $P($S(X1:X1,1:DIS),".")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMUFNC1 4263 printed Dec 13, 2024@02:02:50 Page 2
- IVMUFNC1 ;ALB/SEK - INPATIENT/OUTPATIENT CALCULATIONS ; 06/19/2003
- +1 ;;2.0;INCOME VERIFICATION MATCH ;**3,11,80**; 21-OCT-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- EN(DFN,IVMMTDT,IVMQUERY) ; number of inpatient and outpatient days since IVMMTDT date to
- +1 ; IVMENDT (earliest of day before next means test and day before current date).
- +2 ; Input: DFN -- pointer to patient in file #2
- +3 ; IVMMTDT -- Means Test date/time for the patient
- +4 ; IVMQUERY("OVIS") -- # of the QUERY that is currently open or
- +5 ; undefined, zero, or null if no QUERY opened for
- +6 ; finding outpatient visits
- +7 ; Output: 1^2 where piece 1 = # of inpatient days
- +8 ; piece 2 = # of outpatient days
- +9 ;
- +10 NEW IVMAD,IVMADMDT,IVMD,IVMDCN,IVMDT,IVMDGPM,IVMDISDT,IVMENDT,IVMF,IVMI,IVMIN,IVMOUT
- +11 NEW IVMASIH,IVMADPTR,IVMDATE,VAINDT,VADMVT,VAIP,VAERR
- +12 ;
- +13 SET (IVMIN,IVMOUT)=0
- +14 IF '$GET(IVMMTDT)
- GOTO EPQ
- +15 SET IVMMTDT=$PIECE($$LST^DGMTU(DFN,IVMMTDT),"^",2)
- +16 IF '$GET(IVMMTDT)
- GOTO EPQ
- +17 SET IVMMTDT=$PIECE(IVMMTDT,".")
- +18 KILL ^TMP($JOB,"IVMUFNC1")
- +19 ;
- +20 ; - quit if the effective date of the test is today
- +21 IF IVMMTDT=DT
- GOTO EPQ
- +22 ;
- +23 ; Calculate number of inpatient days
- +24 ;
- +25 ; get end date
- +26 SET IVMENDT=$$END^IVMUFNC2(DFN,IVMMTDT)
- +27 ;
- +28 ; - find if patient was an inpatient on IVMMTDT
- +29 SET VAINDT=IVMMTDT
- DO ADM^VADPT2
- +30 IF VADMVT
- SET IVMASIH=$PIECE($GET(^DGPM(VADMVT,0)),"^",21)
- Begin DoDot:1
- +31 IF IVMASIH
- Begin DoDot:2
- +32 SET IVMIN=IVMIN+$$LOS(VADMVT,IVMMTDT)
- +33 SET IVMADPTR=$PIECE($GET(^DGPM(IVMASIH,0)),"^",14)
- +34 SET IVMDATE=$$CHK(IVMADPTR,IVMMTDT)
- +35 SET IVMIN=IVMIN+$$LOS(IVMADPTR,IVMDATE)
- End DoDot:2
- QUIT
- +36 SET VAIP("D")=IVMMTDT
- DO IN5^VADPT
- +37 IF 'VAIP(10)
- SET IVMDATE=$$CHK(VADMVT,IVMMTDT)
- +38 SET IVMIN=IVMIN+$$LOS(VADMVT,$SELECT('VAIP(10):IVMDATE,1:IVMMTDT))
- End DoDot:1
- +39 ;
- +40 ; - find admissions after IVMMTDT to end date
- +41 SET IVMD=""
- FOR
- SET IVMD=$ORDER(^DGPM("ATID1",DFN,IVMD))
- if 'IVMD!(9999999.9999999-IVMD<IVMMTDT)
- QUIT
- IF 9999999.9999999-IVMD'>IVMENDT
- SET IVMIN=IVMIN+$$LOS(+$ORDER(^(IVMD,0)))
- +42 ;
- +43 ; Calculate number of outpatient days
- +44 ;
- +45 DO EN^IVMUFNC2(.IVMQUERY)
- +46 ;
- EPQ KILL ^TMP($JOB,"IVMUFNC1")
- +1 QUIT IVMIN_"^"_IVMOUT
- +2 ;
- +3 ;
- LOS(IVMDG,IVMST) ; Calculate the length of stay for an admission.
- +1 ; Input: IVMDG -- Pointer to the admission in file #405
- +2 ; IVMST -- [Optional] Date after the admission on
- +3 ; which to begin calculation of the LOS.
- +4 ; Output: X -- Length of stay (in days)
- +5 ;
- +6 NEW A,D,DFN,DGE,DGS,I,X,X1,X2,LOP,LOA,LOAS,LOS
- +7 SET (LOP,LOA,LOAS)=0
- +8 IF $SELECT('$DATA(IVMDG):1,'$DATA(^DGPM(+IVMDG,0)):1,$PIECE(^(0),"^",2)'=1:1,1:0)
- SET X=0
- GOTO Q
- +9 SET X=^DGPM(+IVMDG,0)
- SET DFN=$PIECE(^(0),"^",3)
- SET (X2,A)=+X
- SET D=$SELECT($DATA(^DGPM(+$PIECE(X,"^",17),0)):+^(0),1:"")
- SET (X1,D)=$SELECT('D:IVMENDT,D>IVMENDT:IVMENDT,1:D)
- +10 IF $GET(IVMST)'<$PIECE(D,".")
- SET X=0
- GOTO Q
- +11 if $GET(IVMST)
- SET (X2,A)=IVMST
- +12 ; LOS = elapsed time between admission and discharge (or end date)
- DO ^%DTC
- SET LOS=$SELECT(X:X,1:1)
- +13 FOR I=A:0
- SET I=$ORDER(^DGPM("APCA",DFN,IVMDG,I))
- if 'I
- QUIT
- SET DGS=$ORDER(^(I,0))
- IF $DATA(^DGPM(+DGS,0))
- SET DGS=^(0)
- if +DGS>IVMENDT
- QUIT
- IF "^1^2^3^13^43^44^45^"[("^"_$PIECE(DGS,"^",18)_"^")
- SET X2=+DGS
- SET DGS=$PIECE(DGS,"^",18)
- DO ABS
- if 'I
- QUIT
- +14 SET X=LOS-LOA-LOAS
- Q QUIT X
- +1 ;
- ABS ; If patient was out on absence, find return
- +1 SET X1=0
- FOR I=I:0
- SET I=$ORDER(^DGPM("APCA",DFN,IVMDG,I))
- if 'I
- QUIT
- SET DGE=$ORDER(^(I,0))
- IF $DATA(^DGPM(+DGE,0))
- SET DGE=^(0)
- IF "^14^22^23^24^"[("^"_$PIECE(DGE,"^",18)_"^")
- SET X1=+DGE
- SET DGE=$PIECE(DGE,"^",18)
- QUIT
- +2 ; if no return from absence, use discharge or end date
- +3 ; if return from absence greater then end date use end date
- +4 IF 'X1!(X1>D)
- SET X1=D
- +5 ;if TO AA <96, but not FROM AA<96, count as absence, not pass
- DO ^%DTC
- SET X=$SELECT(X:X,1:1)
- IF DGS=1
- IF $SELECT('$DATA(DGE):1,DGE'=25:1,1:0)
- SET LOP=LOP+X
- QUIT
- +6 IF "^1^2^3^25^26^"[("^"_DGS_"^")
- SET LOA=LOA+X
- QUIT
- +7 SET LOAS=LOAS+X
- QUIT
- +8 ;
- CHK(ADPTR,DATE) ; Determine date that patient returned from leave
- +1 ; Input: ADPTR -- Pointer to admission in file #405
- +2 ; DATE -- Date the patient was on leave or ASIH
- +3 ; Output: X1 -- Date the patient returned from leave
- +4 NEW X,Y,I,%,X1,X2,DIS,DGE
- +5 SET X=^DGPM(+ADPTR,0)
- SET DIS=$SELECT($DATA(^DGPM(+$PIECE(X,"^",17),0)):+^(0),1:"")
- SET DIS=$SELECT('DIS:IVMENDT,DIS>IVMENDT:IVMENDT,1:DIS)
- +6 SET X1=0
- FOR I=DATE:0
- SET I=$ORDER(^DGPM("APCA",DFN,ADPTR,I))
- if 'I
- QUIT
- SET DGE=$ORDER(^(I,0))
- IF $DATA(^DGPM(+DGE,0))
- SET DGE=^(0)
- IF "^14^22^23^24^"[("^"_$PIECE(DGE,"^",18)_"^")
- SET X1=+DGE
- QUIT
- +7 QUIT $PIECE($SELECT(X1:X1,1:DIS),".")