ADGIP1.m

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