ADGOASC ; IHS/ADC/PDW/ENM - CALC OUTSTANDING A SHEETS LIST ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
K ^TMP("DGZOAS",$J)
K DGCT,DGCCT,DGCOT,DGERR,DGCTEX
A ; -- driver
D LP3,CNT,Q
G ^ADGOASP
;
LP3 ; -- loop discharges
N DGDT,DFN,IFN
S DGDT=$E(DGMON,1,5)_"00",DGMON2=$E(DGMON2,1,5)_"31"
F S DGDT=$O(^DGPM("AMV3",DGDT)) Q:'DGDT!(DGDT>(DGMON2+.2400)) D
. S DFN=0 F S DFN=$O(^DGPM("AMV3",DGDT,DFN)) Q:'DFN D
.. S IFN=0 F S IFN=$O(^DGPM("AMV3",DGDT,DFN,IFN)) Q:'IFN D 1
Q
;
1 ; -- discharge count
N VINP,VIFN
S DGM=$E(DGDT,1,5),DGCT(DGM)=$S($D(DGCT(DGM)):DGCT(DGM)+1,1:1)
;--check v hosp
S VINP=$O(^AUPNVINP("AA",DFN,9999999-$E(DGDT,1,7),0))
I 'VINP D ERR Q
I '$D(^AUPNVINP(VINP,0)) D ERR Q
S VIFN=$P(^AUPNVINP(VINP,0),U,3) I '$D(^AUPNVSIT(VIFN,0)) D ERR Q
;--count # exported
I $P(^AUPNVSIT(VIFN,0),U,14)]"" S DGCTEX(DGM)=$G(DGCTEX(DGM))+1
;--check if coding complete
I $P(^AUPNVINP(VINP,0),U,15)=1 D OUT Q
S DGCCT(DGM)=$S($D(DGCCT(DGM)):DGCCT(DGM)+1,1:1)
Q
;
OUT ;--discharges not coded yet
N TS
S DGCOT(DGM)=$S($D(DGCOT(DGM)):DGCOT(DGM)+1,1:1)
S TS=$P(^AUPNVINP(VINP,0),U,5)
S ^TMP("DGZOAS",$J,"ZOUT",$E(DGDT,1,7),DFN)=TS
Q
;
CNT ;--store counts
N X
S X=0 F S X=$O(DGCT(X)) Q:'X D
. S ^TMP("DGZOAS",$J,"CT",X)=DGCT(X)
S X=0 F S X=$O(DGCCT(X)) Q:'X D
. S ^TMP("DGZOAS",$J,"CT1",X)=DGCCT(X)
S X=0 F S X=$O(DGCOT(X)) Q:'X D
. S ^TMP("DGZOAS",$J,"CT2",X)=DGCOT(X)
S X=0 F S X=$O(DGERR(X)) Q:'X D
. S ^TMP("DGZOAS",$J,"CT3",X)=DGERR(X)
S X=0 F S X=$O(DGCTEX(X)) Q:'X D
. S ^TMP("DGZOAS",$J,"CT4",X)=DGCTEX(X)
Q
;
Q ; -- end
K DGCT,DGCCT,DGCOT,DGERR,DGCTEX,DGM,DFN
Q
;
ERR ;--visit errors
S DGERR(DGM)=$S($D(DGERR(DGM)):DGERR(DGM)+1,1:1)
S ^TMP("DGZOAS",$J,"ZERR",DGDT,DFN)="" Q
ADGOASC ; IHS/ADC/PDW/ENM - CALC OUTSTANDING A SHEETS LIST ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
+3 KILL ^TMP("DGZOAS",$JOB)
+4 KILL DGCT,DGCCT,DGCOT,DGERR,DGCTEX
A ; -- driver
+1 DO LP3
DO CNT
DO Q
+2 GOTO ^ADGOASP
+3 ;
LP3 ; -- loop discharges
+1 NEW DGDT,DFN,IFN
+2 SET DGDT=$EXTRACT(DGMON,1,5)_"00"
SET DGMON2=$EXTRACT(DGMON2,1,5)_"31"
+3 FOR
SET DGDT=$ORDER(^DGPM("AMV3",DGDT))
IF 'DGDT!(DGDT>(DGMON2+.2400))
QUIT
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^DGPM("AMV3",DGDT,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+5 SET IFN=0
FOR
SET IFN=$ORDER(^DGPM("AMV3",DGDT,DFN,IFN))
IF 'IFN
QUIT
DO 1
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
1 ; -- discharge count
+1 NEW VINP,VIFN
+2 SET DGM=$EXTRACT(DGDT,1,5)
SET DGCT(DGM)=$SELECT($DATA(DGCT(DGM)):DGCT(DGM)+1,1:1)
+3 ;--check v hosp
+4 SET VINP=$ORDER(^AUPNVINP("AA",DFN,9999999-$EXTRACT(DGDT,1,7),0))
+5 IF 'VINP
DO ERR
QUIT
+6 IF '$DATA(^AUPNVINP(VINP,0))
DO ERR
QUIT
+7 SET VIFN=$PIECE(^AUPNVINP(VINP,0),U,3)
IF '$DATA(^AUPNVSIT(VIFN,0))
DO ERR
QUIT
+8 ;--count # exported
+9 IF $PIECE(^AUPNVSIT(VIFN,0),U,14)]""
SET DGCTEX(DGM)=$GET(DGCTEX(DGM))+1
+10 ;--check if coding complete
+11 IF $PIECE(^AUPNVINP(VINP,0),U,15)=1
DO OUT
QUIT
+12 SET DGCCT(DGM)=$SELECT($DATA(DGCCT(DGM)):DGCCT(DGM)+1,1:1)
+13 QUIT
+14 ;
OUT ;--discharges not coded yet
+1 NEW TS
+2 SET DGCOT(DGM)=$SELECT($DATA(DGCOT(DGM)):DGCOT(DGM)+1,1:1)
+3 SET TS=$PIECE(^AUPNVINP(VINP,0),U,5)
+4 SET ^TMP("DGZOAS",$JOB,"ZOUT",$EXTRACT(DGDT,1,7),DFN)=TS
+5 QUIT
+6 ;
CNT ;--store counts
+1 NEW X
+2 SET X=0
FOR
SET X=$ORDER(DGCT(X))
IF 'X
QUIT
Begin DoDot:1
+3 SET ^TMP("DGZOAS",$JOB,"CT",X)=DGCT(X)
End DoDot:1
+4 SET X=0
FOR
SET X=$ORDER(DGCCT(X))
IF 'X
QUIT
Begin DoDot:1
+5 SET ^TMP("DGZOAS",$JOB,"CT1",X)=DGCCT(X)
End DoDot:1
+6 SET X=0
FOR
SET X=$ORDER(DGCOT(X))
IF 'X
QUIT
Begin DoDot:1
+7 SET ^TMP("DGZOAS",$JOB,"CT2",X)=DGCOT(X)
End DoDot:1
+8 SET X=0
FOR
SET X=$ORDER(DGERR(X))
IF 'X
QUIT
Begin DoDot:1
+9 SET ^TMP("DGZOAS",$JOB,"CT3",X)=DGERR(X)
End DoDot:1
+10 SET X=0
FOR
SET X=$ORDER(DGCTEX(X))
IF 'X
QUIT
Begin DoDot:1
+11 SET ^TMP("DGZOAS",$JOB,"CT4",X)=DGCTEX(X)
End DoDot:1
+12 QUIT
+13 ;
Q ; -- end
+1 KILL DGCT,DGCCT,DGCOT,DGERR,DGCTEX,DGM,DFN
+2 QUIT
+3 ;
ERR ;--visit errors
+1 SET DGERR(DGM)=$SELECT($DATA(DGERR(DGM)):DGERR(DGM)+1,1:1)
+2 SET ^TMP("DGZOAS",$JOB,"ZERR",DGDT,DFN)=""
QUIT
