BWRPSNPR.m

BWRPSNPR ;IHS/ANMC/MWR - REPORT: RETRIEVE A SNAPSHOT;15-Feb-2003 22:11;PLS

 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

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

 ;;  CALLED BY OPTION: "BW PRINT/RETRIEVE SNAPSHOT" TO DISPLAY A

 ;;  PREVIOUS SNAPSHOT.

 ;

 D SETVARS^BWUTL5 S BWPOP=0,BWFAC=DUZ(2)

 N A,B,C,D,E,F,G,H,J,K,L,M,N,P,Q,R,S,X,Y

 D TITLE^BWUTL5("RETRIEVE A PROGRAM SNAPSHOT")

 D RETRIEVE G:BWPOP EXIT

 D DEVICE   G:BWPOP EXIT

 D LOADVARS

 D ^BWRPSNP1

 ;

EXIT ;EP

 D KILLALL^BWUTL8

 Q

 ;

 ;

RETRIEVE ;EP

 ;---> RETRIEVE A SNAPSHOT

 N DIC,Y

 W !!?3,"Select the Snapshot you wish to display or print."

 D DIC^BWFMAN(9002086.71,"QEMA",.Y,"   Select Snapshot: ")

 I Y<0 S BWPOP=1 Q

 S BWDT=+Y

 Q

 ;

DEVICE ;EP

 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.

 S ZTRTN="DEQUEUE^BWRPSNPR"

 F BWSV="DT" D

 .I $D(@("BW"_BWSV)) S ZTSAVE("BW"_BWSV)=""

 D ZIS^BWUTL2(.BWPOP,1)

 Q

 ;

DEQUEUE ;EP

 ;---> QUEUED REPORT

 N A,B,C,D,E,F,G,H,J,K,L,M,N,P,Q,R,S,X,Y

 D SETVARS^BWUTL5,LOADVARS,^BWRPSNP1,EXIT

 Q

 ;

LOADVARS ;EP

 S Y=^BWSNAP(BWDT,0)

 S BWFAC=$P(Y,U,2),A=$P(Y,U,3),B=$P(Y,U,4),C=$P(Y,U,5),D=$P(Y,U,6)

 S E=$P(Y,U,7),F=$P(Y,U,8),G=$P(Y,U,9),H=$P(Y,U,10),S=$P(Y,U,11)

 S J=$P(Y,U,12),K=$P(Y,U,13),L=$P(Y,U,14),P=$P(Y,U,15),Q=$P(Y,U,16)

 S R=$P(Y,U,17)

 Q

BWRPSNPR  ;IHS/ANMC/MWR - REPORT: RETRIEVE A SNAPSHOT;15-Feb-2003 22:11;PLS

 +1       ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

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

 +3       ;;  CALLED BY OPTION: "BW PRINT/RETRIEVE SNAPSHOT" TO DISPLAY A

 +4       ;;  PREVIOUS SNAPSHOT.

 +5       ;

 +6        DO SETVARS^BWUTL5

           SET BWPOP=0

           SET BWFAC=DUZ(2)

 +7        NEW A,B,C,D,E,F,G,H,J,K,L,M,N,P,Q,R,S,X,Y

 +8        DO TITLE^BWUTL5("RETRIEVE A PROGRAM SNAPSHOT")

 +9        DO RETRIEVE

           IF BWPOP

               GOTO EXIT

 +10       DO DEVICE

           IF BWPOP

               GOTO EXIT

 +11       DO LOADVARS

 +12       DO ^BWRPSNP1

 +13      ;

EXIT      ;EP

 +1        DO KILLALL^BWUTL8

 +2        QUIT 

 +3       ;

 +4       ;

RETRIEVE  ;EP

 +1       ;---> RETRIEVE A SNAPSHOT

 +2        NEW DIC,Y

 +3        WRITE !!?3,"Select the Snapshot you wish to display or print."

 +4        DO DIC^BWFMAN(9002086.71,"QEMA",.Y,"   Select Snapshot: ")

 +5        IF Y<0

               SET BWPOP=1

               QUIT 

 +6        SET BWDT=+Y

 +7        QUIT 

 +8       ;

DEVICE    ;EP

 +1       ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.

 +2        SET ZTRTN="DEQUEUE^BWRPSNPR"

 +3        FOR BWSV="DT"

               Begin DoDot:1

 +4                IF $DATA(@("BW"_BWSV))

                       SET ZTSAVE("BW"_BWSV)=""

               End DoDot:1

 +5        DO ZIS^BWUTL2(.BWPOP,1)

 +6        QUIT 

 +7       ;

DEQUEUE   ;EP

 +1       ;---> QUEUED REPORT

 +2        NEW A,B,C,D,E,F,G,H,J,K,L,M,N,P,Q,R,S,X,Y

 +3        DO SETVARS^BWUTL5

           DO LOADVARS

           DO ^BWRPSNP1

           DO EXIT

 +4        QUIT 

 +5       ;

LOADVARS  ;EP

 +1        SET Y=^BWSNAP(BWDT,0)

 +2        SET BWFAC=$PIECE(Y,U,2)

           SET A=$PIECE(Y,U,3)

           SET B=$PIECE(Y,U,4)

           SET C=$PIECE(Y,U,5)

           SET D=$PIECE(Y,U,6)

 +3        SET E=$PIECE(Y,U,7)

           SET F=$PIECE(Y,U,8)

           SET G=$PIECE(Y,U,9)

           SET H=$PIECE(Y,U,10)

           SET S=$PIECE(Y,U,11)

 +4        SET J=$PIECE(Y,U,12)

           SET K=$PIECE(Y,U,13)

           SET L=$PIECE(Y,U,14)

           SET P=$PIECE(Y,U,15)

           SET Q=$PIECE(Y,U,16)

 +5        SET R=$PIECE(Y,U,17)

 +6        QUIT