- 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
