Routine: WVLABLG1

WVLABLG1 ;HCIOFO/FT IHS/ANMC/MWR - DISPLAY LAB LOG; ;9/29/98  12:37

 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998

 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 ;;  DISPLAY CODE FOR LAB LOG.  CALLED BY WVLABLG.

DISPLAY ;EP

 ;---> WVCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.

 ;---> WVTITLE=TITLE AT TOP OF DISPLAY HEADER.

 ;---> WVSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).

 ;---> WVCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).

 ;---> WVCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).

 ;---> WVPRMT(1,Q)=PROMPTS FOR DIR.

 N WVTITLE,WVTITLE1,N,Y S:WVB WVCONF=1

 U IO

 .I 'WVB S WVTITLE1="TOTALS" Q

 .I WVC=1 S WVTITLE1="LISTED BY ACCESSION#" Q

 .I WVC=2 S WVTITLE1="LISTED BY PATIENT" Q

 .S WVTITLE="UNKNOWN REPORT"

 S WVTITLE="* * *  WOMEN'S HEALTH: LAB LOG "_WVTITLE1_"  * * *"

 D CENTERT^WVUTL5(.WVTITLE)

 S WVSUBH="SUBHEAD^WVLABLG1"

 D TOPHEAD^WVUTL7

 S (WVPOP,N)=0

NOMATCH ;EP

 ;---> QUIT IF NO RECORDS MATCH.

 I '$D(^TMP("WV",$J,1)) D  Q

 .D HEADER3^WVUTL7

 .W !!?5,"No records match the selected criteria.",!

 .I WVCRT&('$D(IO("S"))) D DIRZ^WVUTL3 W @IOF

 .D ^%ZISC S WVPOP=1

 D:WVB DISPLAY1

 I WVPOP D

 .W !?5,"Because you have entered ^, the remainder of the individual"

 .W !?5,"procedures will not be displayed.  The totals that follow,"

 .W !?5,"however, are accurate for the selected date range."

 I 'WVB K WVSUBH D HEADER3^WVUTL7

 D TOTALS,END

DISPLAY1 ;EP

 D HEADER3^WVUTL7

 F  S N=$O(^TMP("WV",$J,2,N)) Q:'N!(WVPOP)  D

 .I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP  D

 ..S WVPAGE=WVPAGE+1

 ..D HEADER3^WVUTL7

 .S Y=^TMP("WV",$J,2,N),M=N

 .W !,$$SLDT2^WVUTL5($P(Y,U,3))

 .W ?9,$P(Y,U,4)

 .W ?21,$E($P(Y,U,2),1,18)

 .W ?41,$P(Y,U)

 .W ?53,$E($P(Y,U,8),1,10)

 .W ?65,$E($P(Y,U,9),1,14)

 .W !?9,"Date of ",$E($P(Y,U,5),1,23),": ",$P(Y,U,7)

 .W ?53,"Entered by: ",$E($P(Y,U,10),1,14)

 .W !?43,"Res/Diag: ",?53,$E($P(Y,U,12),1,26)

 .W !,WVLINE

TOTALS ;EP

 N N,R S (N,R)=0

 I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP  D

 .S WVPAGE=WVPAGE+1 K WVSUBH

 .D HEADER3^WVUTL7

 F  S N=$O(^TMP("WV",$J,2,N)) Q:'N  D

 .S M=N S:($P(^TMP("WV",$J,2,N),U,12)="NOT ENTERED") R=R+1

 W !?4,"*"

 W ?10,"TOTAL PROCEDURES: ",M,?37,"PROCEDURES WITHOUT RESULTS: ",R

 W ?75,"*"

 W !,WVLINE

END ;EP

 I WVCRT&('$D(IO("S")))&('WVPOP) D DIRZ^WVUTL3

 D ^%ZISC

SUBHEAD ;EP

 ;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.

 W !,"DATE",?9,"ACCESSION#",?21,"PATIENT"

 W ?41,$$PNLB^WVUTL5(),?53,"LOCATION",?65,"PROVIDER",!

 W $$REPEAT^XLFSTR("=",80)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVLABLG1   2589     printed  Apr 23, 2025@19:01:37                                                                                                                                                                                                    Page 2

WVLABLG1  ;HCIOFO/FT IHS/ANMC/MWR - DISPLAY LAB LOG; ;9/29/98  12:37

 +1       ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998

 +2       ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 +3       ;;  DISPLAY CODE FOR LAB LOG.  CALLED BY WVLABLG.

 +4       ;

DISPLAY   ;EP

 +1       ;---> WVCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.

 +2       ;---> WVTITLE=TITLE AT TOP OF DISPLAY HEADER.

 +3       ;---> WVSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).

 +4       ;---> WVCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).

 +5       ;---> WVCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).

 +6       ;---> WVPRMT(1,Q)=PROMPTS FOR DIR.

 +7       ;

 +8        NEW WVTITLE,WVTITLE1,N,Y

           if WVB

               SET WVCONF=1

 +9        USE IO

 +10       Begin DoDot:1

 +11           IF 'WVB

                   SET WVTITLE1="TOTALS"

                   QUIT

 +12           IF WVC=1

                   SET WVTITLE1="LISTED BY ACCESSION#"

                   QUIT

 +13           IF WVC=2

                   SET WVTITLE1="LISTED BY PATIENT"

                   QUIT

 +14           SET WVTITLE="UNKNOWN REPORT"

           End DoDot:1

 +15       SET WVTITLE="* * *  WOMEN'S HEALTH: LAB LOG "_WVTITLE1_"  * * *"

 +16       DO CENTERT^WVUTL5(.WVTITLE)

 +17       SET WVSUBH="SUBHEAD^WVLABLG1"

 +18       DO TOPHEAD^WVUTL7

 +19       SET (WVPOP,N)=0

NOMATCH   ;EP

 +1       ;---> QUIT IF NO RECORDS MATCH.

 +2        IF '$DATA(^TMP("WV",$JOB,1))

               Begin DoDot:1

 +3                DO HEADER3^WVUTL7

 +4                WRITE !!?5,"No records match the selected criteria.",!

 +5                IF WVCRT&('$DATA(IO("S")))

                       DO DIRZ^WVUTL3

                       WRITE @IOF

 +6                DO ^%ZISC

                   SET WVPOP=1

               End DoDot:1

               QUIT

 +7       ;

 +8        if WVB

               DO DISPLAY1

 +9        IF WVPOP

               Begin DoDot:1

 +10               WRITE !?5,"Because you have entered ^, the remainder of the individual"

 +11               WRITE !?5,"procedures will not be displayed.  The totals that follow,"

 +12               WRITE !?5,"however, are accurate for the selected date range."

               End DoDot:1

 +13       IF 'WVB

               KILL WVSUBH

               DO HEADER3^WVUTL7

 +14       DO TOTALS

           DO END

 +15       QUIT

 +16      ;

 +17      ;

DISPLAY1  ;EP

 +1        DO HEADER3^WVUTL7

 +2        FOR

               SET N=$ORDER(^TMP("WV",$JOB,2,N))

               if 'N!(WVPOP)

                   QUIT

               Begin DoDot:1

 +3                IF $Y+6>IOSL

                       if WVCRT

                           DO DIRZ^WVUTL3

                       if WVPOP

                           QUIT

                       Begin DoDot:2

 +4                        SET WVPAGE=WVPAGE+1

 +5                        DO HEADER3^WVUTL7

                       End DoDot:2

 +6                SET Y=^TMP("WV",$JOB,2,N)

                   SET M=N

 +7                WRITE !,$$SLDT2^WVUTL5($PIECE(Y,U,3))

 +8                WRITE ?9,$PIECE(Y,U,4)

 +9                WRITE ?21,$EXTRACT($PIECE(Y,U,2),1,18)

 +10               WRITE ?41,$PIECE(Y,U)

 +11               WRITE ?53,$EXTRACT($PIECE(Y,U,8),1,10)

 +12               WRITE ?65,$EXTRACT($PIECE(Y,U,9),1,14)

 +13               WRITE !?9,"Date of ",$EXTRACT($PIECE(Y,U,5),1,23),": ",$PIECE(Y,U,7)

 +14               WRITE ?53,"Entered by: ",$EXTRACT($PIECE(Y,U,10),1,14)

 +15               WRITE !?43,"Res/Diag: ",?53,$EXTRACT($PIECE(Y,U,12),1,26)

 +16               WRITE !,WVLINE

               End DoDot:1

 +17       QUIT

 +18      ;

TOTALS    ;EP

 +1        NEW N,R

           SET (N,R)=0

 +2        IF $Y+6>IOSL

               if WVCRT

                   DO DIRZ^WVUTL3

               if WVPOP

                   QUIT

               Begin DoDot:1

 +3                SET WVPAGE=WVPAGE+1

                   KILL WVSUBH

 +4                DO HEADER3^WVUTL7

               End DoDot:1

 +5       ;

 +6        FOR

               SET N=$ORDER(^TMP("WV",$JOB,2,N))

               if 'N

                   QUIT

               Begin DoDot:1

 +7                SET M=N

                   if ($PIECE(^TMP("WV",$JOB,2,N),U,12)="NOT ENTERED")

                       SET R=R+1

               End DoDot:1

 +8        WRITE !?4,"*"

 +9        WRITE ?10,"TOTAL PROCEDURES: ",M,?37,"PROCEDURES WITHOUT RESULTS: ",R

 +10       WRITE ?75,"*"

 +11       WRITE !,WVLINE

 +12       QUIT

 +13      ;

END       ;EP

 +1        IF WVCRT&('$DATA(IO("S")))&('WVPOP)

               DO DIRZ^WVUTL3

 +2        DO ^%ZISC

 +3        QUIT

 +4       ;

SUBHEAD   ;EP

 +1       ;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.

 +2        WRITE !,"DATE",?9,"ACCESSION#",?21,"PATIENT"

 +3        WRITE ?41,$$PNLB^WVUTL5(),?53,"LOCATION",?65,"PROVIDER",!

 +4        WRITE $$REPEAT^XLFSTR("=",80)

 +5        QUIT

WVLABLG1.m