- 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
