- ADGIP1 ; IHS/ADC/PDW/ENM - PRINT INPATIENT LIST ; [ 03/25/1999 11:48 AM ]
- ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- ;
- ;***> print heading
- U IO S (DGZRM,X)=110 X ^%ZOSF("RM") ;set margin to 110
- S DGSTOP="" I IOST["C-" W @IOF
- W ?26,"*****Confidential Patient Data Covered by Privacy Act*****",!
- S %DT="R",X="NOW" D ^%DT X ^DD("DD")
- S DGDATE=$P(Y,"@",1)_" "_$P(Y,"@",2)
- S DGTL=$P($G(^AUTTLOC(DUZ(2),0)),U,7)_" INPATIENT LIST FOR "_DGDATE
- W ?DGZRM-$L(DGTL)/2,DGTL," ("_DGCNT_" patients in house)",!!
- W ?2,"NAME",?31,"AGE",?37,"WARD SRVC",?47,"COMMUNITY",?61,"HRCN"
- W ?71,"ADMDATE",?82,"MEDICAID",?97,"MEDICARE",!
- ;
- ;***> loop thru ^utility by name
- G END:'$D(^TMP("DGZINP",$J)) S DGNM=0
- A1 S DGNM=$O(^TMP("DGZINP",$J,DGNM)) G END:DGNM="" S DFN=0
- A2 S DFN=$O(^TMP("DGZINP",$J,DGNM,DFN)) G A1:DFN=""
- ;
- ;***> get data and print it
- S DGSTR=^TMP("DGZINP",$J,DGNM,DFN)
- S DGX=$P(DGSTR,U),DGDT=$E(DGX,4,5)_"/"_$E(DGX,6,7)_"/"_$E(DGX,2,3)
- S DGX=$P(DGSTR,U,4) I DGX'="" S DGSV=$P($G(^DIC(45.7,DGX,0)),U)
- S DGHRCN=$P(DGSTR,U,6)
- W !?2,$E(DGNM,1,26),?30,$P(DGSTR,U,2),?37,$P(DGSTR,U,3)
- W ?42,$E(DGSV,1,3),?47,$E($P(DGSTR,U,5),1,12),?61,DGHRCN
- W ?71,DGDT,?82,$P(DGSTR,U,8),?97,$P(DGSTR,U,7)
- I $Y>(IOSL-7) D NEWPG G END1:DGSTOP=U
- G A2
- ;
- ;
- END ;***> eoj
- I IOST["C-" D PRTOPT^ADGVAR
- END1 W @IOF D KILL^ADGUTIL K ^TMP("DGZINP",$J)
- S X=IOM X ^%ZOSF("RM") ;restore right margin
- D ^%ZISC Q
- ;
- NEWPG ;***> subrtn for end of page control
- I IOST["C-" K DIR S DIR(0)="E" D ^DIR S DGSTOP=X Q:X=U
- W @IOF Q
- ADGIP1 ; IHS/ADC/PDW/ENM - PRINT INPATIENT LIST ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- +2 ;
- +3 ;***> print heading
- +4 ;set margin to 110
- USE IO
- SET (DGZRM,X)=110
- XECUTE ^%ZOSF("RM")
- +5 SET DGSTOP=""
- IF IOST["C-"
- WRITE @IOF
- +6 WRITE ?26,"*****Confidential Patient Data Covered by Privacy Act*****",!
- +7 SET %DT="R"
- SET X="NOW"
- DO ^%DT
- XECUTE ^DD("DD")
- +8 SET DGDATE=$PIECE(Y,"@",1)_" "_$PIECE(Y,"@",2)
- +9 SET DGTL=$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,7)_" INPATIENT LIST FOR "_DGDATE
- +10 WRITE ?DGZRM-$LENGTH(DGTL)/2,DGTL," ("_DGCNT_" patients in house)",!!
- +11 WRITE ?2,"NAME",?31,"AGE",?37,"WARD SRVC",?47,"COMMUNITY",?61,"HRCN"
- +12 WRITE ?71,"ADMDATE",?82,"MEDICAID",?97,"MEDICARE",!
- +13 ;
- +14 ;***> loop thru ^utility by name
- +15 IF '$DATA(^TMP("DGZINP",$JOB))
- GOTO END
- SET DGNM=0
- A1 SET DGNM=$ORDER(^TMP("DGZINP",$JOB,DGNM))
- IF DGNM=""
- GOTO END
- SET DFN=0
- A2 SET DFN=$ORDER(^TMP("DGZINP",$JOB,DGNM,DFN))
- IF DFN=""
- GOTO A1
- +1 ;
- +2 ;***> get data and print it
- +3 SET DGSTR=^TMP("DGZINP",$JOB,DGNM,DFN)
- +4 SET DGX=$PIECE(DGSTR,U)
- SET DGDT=$EXTRACT(DGX,4,5)_"/"_$EXTRACT(DGX,6,7)_"/"_$EXTRACT(DGX,2,3)
- +5 SET DGX=$PIECE(DGSTR,U,4)
- IF DGX'=""
- SET DGSV=$PIECE($GET(^DIC(45.7,DGX,0)),U)
- +6 SET DGHRCN=$PIECE(DGSTR,U,6)
- +7 WRITE !?2,$EXTRACT(DGNM,1,26),?30,$PIECE(DGSTR,U,2),?37,$PIECE(DGSTR,U,3)
- +8 WRITE ?42,$EXTRACT(DGSV,1,3),?47,$EXTRACT($PIECE(DGSTR,U,5),1,12),?61,DGHRCN
- +9 WRITE ?71,DGDT,?82,$PIECE(DGSTR,U,8),?97,$PIECE(DGSTR,U,7)
- +10 IF $Y>(IOSL-7)
- DO NEWPG
- IF DGSTOP=U
- GOTO END1
- +11 GOTO A2
- +12 ;
- +13 ;
- END ;***> eoj
- +1 IF IOST["C-"
- DO PRTOPT^ADGVAR
- END1 WRITE @IOF
- DO KILL^ADGUTIL
- KILL ^TMP("DGZINP",$JOB)
- +1 ;restore right margin
- SET X=IOM
- XECUTE ^%ZOSF("RM")
- +2 DO ^%ZISC
- QUIT
- +3 ;
- NEWPG ;***> subrtn for end of page control
- +1 IF IOST["C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- SET DGSTOP=X
- IF X=U
- QUIT
- +2 WRITE @IOF
- QUIT
