- PSOLBLN2 ;BHAM ISC/RTR - NEW LABEL TRAILER ;06/06/94
- ;;7.0;OUTPATIENT PHARMACY;**92,107,110,305,326**;DEC 1997;Build 11
- Q:'+$G(RXN)!('$G(PSOTRAIL))!('+$G(DFN))
- I $G(PSOBLALL),$P(PPL,",",PI+1)'="" Q
- K ^TMP($J,"PSOMAIL"),^TMP($J,"PSONARR"),^TMP($J,"PSOSUSP") S PRCOPAY=$S('$D(PSOCPN):0,1:1)
- START ;RETURN MAIL
- S PS=$S($D(^PS(59,PSOSITE,0)):^(0),1:"") I $P(PSOSYS,"^",4),$D(^PS(59,+$P($G(PSOSYS),"^",4),0)) S PS=^PS(59,$P($G(PSOSYS),"^",4),0)
- S VAADDR1=$P(PS,"^"),VASTREET=$P(PS,"^",2),STATE=$S($D(^DIC(5,+$P(PS,"^",8),0)):$P(^(0),"^",2),1:"UNKNOWN")
- S PSZIP=$P(PS,"^",5) S PSOHZIP=$S(PSZIP["-":PSZIP,1:$E(PSZIP,1,5)_$S($E(PSZIP,6,9)]"":"-"_$E(PSZIP,6,9),1:""))
- S ^TMP($J,"PSOMAIL",$S(PRCOPAY:1,1:3))="Pharmacy Service (119)",^($S(PRCOPAY:2,1:4))=$G(VAADDR1),^($S(PRCOPAY:3,1:5))=$G(VASTREET),^($S(PRCOPAY:4,1:6))=$P(PS,"^",7)_", "_$G(STATE)_" "_$G(PSOHZIP)
- I PRCOPAY F ZZZ=5:1:15 S ^TMP($J,"PSOMAIL",ZZZ)=""
- I 'PRCOPAY F ZZZ=7:1:17 S ^TMP($J,"PSOMAIL",ZZZ)=""
- S ^TMP($J,"PSOMAIL",$S(PRCOPAY:16,1:18))="Use the label above to mail the computer",^($S(PRCOPAY:17,1:19))="copies back to us. Apply enough postage",^($S(PRCOPAY:18,1:20))="to your envelope to ensure delivery."
- NARR ;SET TMP GLOBAL FOR NARRATIVES
- K ^UTILITY($J,"W") S (DIWL,PSNACNT)=1,DIWR=45,DIWF="",(PSSIXFL,PSSEVFL)=0 F ZZ=0:0 S ZZ=$O(^PS(59,PSOSITE,6,ZZ)) Q:'ZZ I $D(^(ZZ,0)) S X=^(0) D ^DIWP
- F LLL=0:0 S LLL=$O(^UTILITY($J,"W",DIWL,LLL)) Q:'LLL S ^TMP($J,"PSONARR",PSNACNT)=^UTILITY($J,"W",DIWL,LLL,0) S PSNACNT=PSNACNT+1,PSSIXFL=1
- I PSSIXFL S ^TMP($J,"PSONARR",PSNACNT)="" S PSNACNT=PSNACNT+1
- S DIWL=1,DIWR=45,DIWF="" K ^UTILITY($J,"W") F ZZ=0:0 S ZZ=$O(^PS(59,PSOSITE,7,ZZ)) Q:'ZZ I $D(^(ZZ,0)) S X=^(0) D ^DIWP
- F LLL=0:0 S LLL=$O(^UTILITY($J,"W",DIWL,LLL)) Q:'LLL S ^TMP($J,"PSONARR",PSNACNT)=^UTILITY($J,"W",DIWL,LLL,0) S PSNACNT=PSNACNT+1,PSSEVFL=1
- I $G(PSOCHAMP),$G(PSOTRAMT) D:PSSEVFL S ^TMP($J,"PSONARR",PSNACNT)="REMIT $"_PSOTRAMT_" TO AGENT CASHIER." G SUSP
- .S ^TMP($J,"PSONARR",PSNACNT)="" S PSNACNT=PSNACNT+1
- I 'PRCOPAY G SUSP
- I PSSEVFL S ^TMP($J,"PSONARR",PSNACNT)="" S PSNACNT=PSNACNT+1
- S DIWL=1,DIWR=45,DIWF="" K ^UTILITY($J,"W") F ZZ=0:0 S ZZ=$O(^PS(59,PSOSITE,4,ZZ)) Q:'ZZ I $D(^(ZZ,0)) S X=^(0) D ^DIWP
- F LLL=0:0 S LLL=$O(^UTILITY($J,"W",DIWL,LLL)) Q:'LLL S ^TMP($J,"PSONARR",PSNACNT)=^UTILITY($J,"W",DIWL,LLL,0) S PSNACNT=PSNACNT+1
- SUSP ;SUSPENSE DOCUMENT
- S (PSSUFLG,PSSPCNT)=0 S:'$D(DFN) DFN=+$P($G(^PSRX(RX,0)),"^",2) S PSODFN=DFN,(SPPL,RXX,STA)=""
- I $G(PSODTCUT)']"" S X1=DT,X2=-120 D C^%DTC S PSODTCUT=X
- D ^PSOBUILD S (STA,RXX)="" F S STA=$O(PSOSD(STA)) Q:STA="" F S RXX=$O(PSOSD(STA,RXX)) Q:RXX="" I $P(PSOSD(STA,RXX),"^",2)=5 S SPPL=$P(PSOSD(STA,RXX),"^")_","_SPPL
- D 6^VADPT,PID^VADPT I SPPL="" S PSSUFLG=1 G PRINT
- S ^TMP($J,"PSOSUSP",1)="",^(2)=VADM(1),^(3)=$G(VAPA(1)),^(4)=$G(ADDR(2)) I $G(ADDR(3))="",$G(ADDR(4))="" S ^TMP($J,"PSOSUSP",5)="" G ADD
- I $G(ADDR(3))'="",$G(ADDR(4))="" S ^TMP($J,"PSOSUSP",5)=$G(ADDR(3)) S ^TMP($J,"PSOSUSP",6)="" G ADD
- S ^TMP($J,"PSOSUSP",5)=$G(ADDR(3)),^(6)=$G(ADDR(4)),^(7)=""
- ADD F ZZ=0:0 S ZZ=$O(^TMP($J,"PSOSUSP",ZZ)) Q:'ZZ S PSSPCNT=ZZ
- S PSSPCNT=PSSPCNT+1 S ^TMP($J,"PSOSUSP",PSSPCNT)=" The following prescriptions will be" S PSSPCNT=PSSPCNT+1 S ^TMP($J,"PSOSUSP",PSSPCNT)="mailed to you on or after the date indicated." S PSSPCNT=PSSPCNT+1
- S ^TMP($J,"PSOSUSP",PSSPCNT)="",PSSPCNT=PSSPCNT+1,^(PSSPCNT)="Rx# Date",PSSPCNT=PSSPCNT+1,^(PSSPCNT)="============================================",PSSPCNT=PSSPCNT+1,^(PSSPCNT)="",PSSPCNT=PSSPCNT+1
- F XX=1:1 Q:$P(SPPL,",",XX)="" S PSSSRX=$P(SPPL,",",XX) D
- .S SPNUM=$O(^PS(52.5,"B",PSSSRX,0)) I SPNUM S SPDATE=$P($G(^PS(52.5,SPNUM,0)),"^",2) S Y=SPDATE D DD^%DT S SPDATE=Y
- .S $P(PSOLGTH," ",(20-($L($P(^PSRX(PSSSRX,0),"^")))))="" S ^TMP($J,"PSOSUSP",PSSPCNT)=$P(^PSRX(PSSSRX,0),"^")_PSOLGTH_$G(SPDATE) S PSSPCNT=PSSPCNT+1
- .S ^TMP($J,"PSOSUSP",PSSPCNT)=" "_$$ZZ^PSOSUTL(PSSSRX) S PSSPCNT=PSSPCNT+1 K SPNUM,SPDATE,Y
- PRINT S PSOTRDFN=$P(VADM(2),"^"),PSOTRDFN=$S(PSOTRDFN]"":PSOTRDFN,1:"Unavailable") S Y=DT X ^DD("DD") S EDT=Y
- W ?54,VADM(1)_" "_EDT
- W ! I PRCOPAY,$G(PSOBARS) S X="S",X2=PSOTRDFN,X1=$X W ?54,@PSOBAR1,PSOTRDFN,@PSOBAR0,$C(13) S $X=0
- I PRCOPAY,'$G(PSOBARS) W !!!
- I 'PRCOPAY W !
- I 'PSSUFLG D PRSUS,NPP1 G END
- S (PSNONARR,PSNOADDR,PSNOBOTH)=0 F TTT=1:1 Q:$G(PSNOBOTH) D
- .W $G(^TMP($J,"PSOMAIL",TTT)) S:'$O(^(TTT)) PSNOADDR=1
- .W ?54,$G(^TMP($J,"PSONARR",TTT)),! S:'$O(^(TTT)) PSNONARR=1
- .I PSNOADDR,PSNONARR S PSNOBOTH=1
- D NPP1
- END K ^TMP($J,"PSONARR"),^TMP($J,"PSOMAIL"),^TMP($J,"PSOSUSP"),^UTILITY($J,"W")
- K DIWF,DIWL,DIWR,EDT,LLL,PRCOPAY,PS,PSNACNT,PSNOADDR,PSNOBOTH,PSNONARR,PSNOSUSP,PSNTHREE,PSOLGTH,PSOSD,PSOTRAIL,PSOTRDFN,PSSEVFL,PSSIXFL,PSSPCNT,PSSSRX,PSSUFLG,RXX,SPDATE,SPNUM,SPPL,STATE,TTT,VAADDR1,VADM,VAEL,VAPA,VASTREET,ZZ,ZZZ W @IOF
- I $P(PSOPAR,"^",31) D BLANK^PSOLBLD W @IOF
- Q
- NPP1 ;
- N PSOLAN S PSOLAN=$P($G(^PS(55,DFN,"LAN")),"^",2) S:'PSOLAN PSOLAN=1
- I $G(PSOLAN)=1 D
- . W !,"The VA Notice of Privacy Practices, IB 10-163, which outlines your privacy",!
- . W "rights, is available online at http://www1.va.gov/Health/ or you may obtain",!
- . W "a copy by writing the VHA Privacy Office (19F2), 810 Vermont Avenue NW,",!
- . W "Washington, DC 20420.",!
- I $G(PSOLAN)=2 D
- . W !,"La Notificacion relacionada con las Politicas de Privacidad del Departamento",!
- . W "de Asuntos del Veterano, IB 10-163, contiene los detalles acerca de sus",!
- . W "derechos de privacidad y esta disponible electronicamente en la siguiente",!
- . W "direccion: http://www1.va.gov/Health/. Usted tambien puede conseguir una",!
- . W "copia escribiendo a la Oficina de Privacidad del Departamento de Asuntos de",!
- . W "Salud del Veterano, (19F2), 810 Vermont Avenue NW, Washington, DC 20420.",!
- Q
- ;
- PRSUS S (PSNONARR,PSNOADDR,PSNOSUSP,PSNTHREE)=0 F TTT=1:1 Q:$G(PSNTHREE) D
- .W $G(^TMP($J,"PSOMAIL",TTT)) S:'$O(^(TTT)) PSNOADDR=1
- .W ?54,$G(^TMP($J,"PSONARR",TTT)) S:'$O(^(TTT)) PSNONARR=1
- .W ?102,$G(^TMP($J,"PSOSUSP",TTT)),! S:'$O(^(TTT)) PSNOSUSP=1
- .I PSNOADDR,PSNONARR,PSNOSUSP S PSNTHREE=1
- Q
- PSOLBLN2 ;BHAM ISC/RTR - NEW LABEL TRAILER ;06/06/94
- +1 ;;7.0;OUTPATIENT PHARMACY;**92,107,110,305,326**;DEC 1997;Build 11
- +2 IF '+$GET(RXN)!('$GET(PSOTRAIL))!('+$GET(DFN))
- QUIT
- +3 IF $GET(PSOBLALL)
- IF $PIECE(PPL,",",PI+1)'=""
- QUIT
- +4 KILL ^TMP($JOB,"PSOMAIL"),^TMP($JOB,"PSONARR"),^TMP($JOB,"PSOSUSP")
- SET PRCOPAY=$SELECT('$DATA(PSOCPN):0,1:1)
- START ;RETURN MAIL
- +1 SET PS=$SELECT($DATA(^PS(59,PSOSITE,0)):^(0),1:"")
- IF $PIECE(PSOSYS,"^",4)
- IF $DATA(^PS(59,+$PIECE($GET(PSOSYS),"^",4),0))
- SET PS=^PS(59,$PIECE($GET(PSOSYS),"^",4),0)
- +2 SET VAADDR1=$PIECE(PS,"^")
- SET VASTREET=$PIECE(PS,"^",2)
- SET STATE=$SELECT($DATA(^DIC(5,+$PIECE(PS,"^",8),0)):$PIECE(^(0),"^",2),1:"UNKNOWN")
- +3 SET PSZIP=$PIECE(PS,"^",5)
- SET PSOHZIP=$SELECT(PSZIP["-":PSZIP,1:$EXTRACT(PSZIP,1,5)_$SELECT($EXTRACT(PSZIP,6,9)]"":"-"_$EXTRACT(PSZIP,6,9),1:""))
- +4 SET ^TMP($JOB,"PSOMAIL",$SELECT(PRCOPAY:1,1:3))="Pharmacy Service (119)"
- SET ^($SELECT(PRCOPAY:2,1:4))=$GET(VAADDR1)
- SET ^($SELECT(PRCOPAY:3,1:5))=$GET(VASTREET)
- SET ^($SELECT(PRCOPAY:4,1:6))=$PIECE(PS,"^",7)_", "_$GET(STATE)_" "_$GET(PSOHZIP)
- +5 IF PRCOPAY
- FOR ZZZ=5:1:15
- SET ^TMP($JOB,"PSOMAIL",ZZZ)=""
- +6 IF 'PRCOPAY
- FOR ZZZ=7:1:17
- SET ^TMP($JOB,"PSOMAIL",ZZZ)=""
- +7 SET ^TMP($JOB,"PSOMAIL",$SELECT(PRCOPAY:16,1:18))="Use the label above to mail the computer"
- SET ^($SELECT(PRCOPAY:17,1:19))="copies back to us. Apply enough postage"
- SET ^($SELECT(PRCOPAY:18,1:20))="to your envelope to ensure delivery."
- NARR ;SET TMP GLOBAL FOR NARRATIVES
- +1 KILL ^UTILITY($JOB,"W")
- SET (DIWL,PSNACNT)=1
- SET DIWR=45
- SET DIWF=""
- SET (PSSIXFL,PSSEVFL)=0
- FOR ZZ=0:0
- SET ZZ=$ORDER(^PS(59,PSOSITE,6,ZZ))
- IF 'ZZ
- QUIT
- IF $DATA(^(ZZ,0))
- SET X=^(0)
- DO ^DIWP
- +2 FOR LLL=0:0
- SET LLL=$ORDER(^UTILITY($JOB,"W",DIWL,LLL))
- IF 'LLL
- QUIT
- SET ^TMP($JOB,"PSONARR",PSNACNT)=^UTILITY($JOB,"W",DIWL,LLL,0)
- SET PSNACNT=PSNACNT+1
- SET PSSIXFL=1
- +3 IF PSSIXFL
- SET ^TMP($JOB,"PSONARR",PSNACNT)=""
- SET PSNACNT=PSNACNT+1
- +4 SET DIWL=1
- SET DIWR=45
- SET DIWF=""
- KILL ^UTILITY($JOB,"W")
- FOR ZZ=0:0
- SET ZZ=$ORDER(^PS(59,PSOSITE,7,ZZ))
- IF 'ZZ
- QUIT
- IF $DATA(^(ZZ,0))
- SET X=^(0)
- DO ^DIWP
- +5 FOR LLL=0:0
- SET LLL=$ORDER(^UTILITY($JOB,"W",DIWL,LLL))
- IF 'LLL
- QUIT
- SET ^TMP($JOB,"PSONARR",PSNACNT)=^UTILITY($JOB,"W",DIWL,LLL,0)
- SET PSNACNT=PSNACNT+1
- SET PSSEVFL=1
- +6 IF $GET(PSOCHAMP)
- IF $GET(PSOTRAMT)
- IF PSSEVFL
- Begin DoDot:1
- +7 SET ^TMP($JOB,"PSONARR",PSNACNT)=""
- SET PSNACNT=PSNACNT+1
- End DoDot:1
- SET ^TMP($JOB,"PSONARR",PSNACNT)="REMIT $"_PSOTRAMT_" TO AGENT CASHIER."
- GOTO SUSP
- +8 IF 'PRCOPAY
- GOTO SUSP
- +9 IF PSSEVFL
- SET ^TMP($JOB,"PSONARR",PSNACNT)=""
- SET PSNACNT=PSNACNT+1
- +10 SET DIWL=1
- SET DIWR=45
- SET DIWF=""
- KILL ^UTILITY($JOB,"W")
- FOR ZZ=0:0
- SET ZZ=$ORDER(^PS(59,PSOSITE,4,ZZ))
- IF 'ZZ
- QUIT
- IF $DATA(^(ZZ,0))
- SET X=^(0)
- DO ^DIWP
- +11 FOR LLL=0:0
- SET LLL=$ORDER(^UTILITY($JOB,"W",DIWL,LLL))
- IF 'LLL
- QUIT
- SET ^TMP($JOB,"PSONARR",PSNACNT)=^UTILITY($JOB,"W",DIWL,LLL,0)
- SET PSNACNT=PSNACNT+1
- SUSP ;SUSPENSE DOCUMENT
- +1 SET (PSSUFLG,PSSPCNT)=0
- IF '$DATA(DFN)
- SET DFN=+$PIECE($GET(^PSRX(RX,0)),"^",2)
- SET PSODFN=DFN
- SET (SPPL,RXX,STA)=""
- +2 IF $GET(PSODTCUT)']""
- SET X1=DT
- SET X2=-120
- DO C^%DTC
- SET PSODTCUT=X
- +3 DO ^PSOBUILD
- SET (STA,RXX)=""
- FOR
- SET STA=$ORDER(PSOSD(STA))
- IF STA=""
- QUIT
- FOR
- SET RXX=$ORDER(PSOSD(STA,RXX))
- IF RXX=""
- QUIT
- IF $PIECE(PSOSD(STA,RXX),"^",2)=5
- SET SPPL=$PIECE(PSOSD(STA,RXX),"^")_","_SPPL
- +4 DO 6^VADPT
- DO PID^VADPT
- IF SPPL=""
- SET PSSUFLG=1
- GOTO PRINT
- +5 SET ^TMP($JOB,"PSOSUSP",1)=""
- SET ^(2)=VADM(1)
- SET ^(3)=$GET(VAPA(1))
- SET ^(4)=$GET(ADDR(2))
- IF $GET(ADDR(3))=""
- IF $GET(ADDR(4))=""
- SET ^TMP($JOB,"PSOSUSP",5)=""
- GOTO ADD
- +6 IF $GET(ADDR(3))'=""
- IF $GET(ADDR(4))=""
- SET ^TMP($JOB,"PSOSUSP",5)=$GET(ADDR(3))
- SET ^TMP($JOB,"PSOSUSP",6)=""
- GOTO ADD
- +7 SET ^TMP($JOB,"PSOSUSP",5)=$GET(ADDR(3))
- SET ^(6)=$GET(ADDR(4))
- SET ^(7)=""
- ADD FOR ZZ=0:0
- SET ZZ=$ORDER(^TMP($JOB,"PSOSUSP",ZZ))
- IF 'ZZ
- QUIT
- SET PSSPCNT=ZZ
- +1 SET PSSPCNT=PSSPCNT+1
- SET ^TMP($JOB,"PSOSUSP",PSSPCNT)=" The following prescriptions will be"
- SET PSSPCNT=PSSPCNT+1
- SET ^TMP($JOB,"PSOSUSP",PSSPCNT)="mailed to you on or after the date indicated."
- SET PSSPCNT=PSSPCNT+1
- +2 SET ^TMP($JOB,"PSOSUSP",PSSPCNT)=""
- SET PSSPCNT=PSSPCNT+1
- SET ^(PSSPCNT)="Rx# Date"
- SET PSSPCNT=PSSPCNT+1
- SET ^(PSSPCNT)="============================================"
- SET PSSPCNT=PSSPCNT+1
- SET ^(PSSPCNT)=""
- SET PSSPCNT=PSSPCNT+1
- +3 FOR XX=1:1
- IF $PIECE(SPPL,",",XX)=""
- QUIT
- SET PSSSRX=$PIECE(SPPL,",",XX)
- Begin DoDot:1
- +4 SET SPNUM=$ORDER(^PS(52.5,"B",PSSSRX,0))
- IF SPNUM
- SET SPDATE=$PIECE($GET(^PS(52.5,SPNUM,0)),"^",2)
- SET Y=SPDATE
- DO DD^%DT
- SET SPDATE=Y
- +5 SET $PIECE(PSOLGTH," ",(20-($LENGTH($PIECE(^PSRX(PSSSRX,0),"^")))))=""
- SET ^TMP($JOB,"PSOSUSP",PSSPCNT)=$PIECE(^PSRX(PSSSRX,0),"^")_PSOLGTH_$GET(SPDATE)
- SET PSSPCNT=PSSPCNT+1
- +6 SET ^TMP($JOB,"PSOSUSP",PSSPCNT)=" "_$$ZZ^PSOSUTL(PSSSRX)
- SET PSSPCNT=PSSPCNT+1
- KILL SPNUM,SPDATE,Y
- End DoDot:1
- PRINT SET PSOTRDFN=$PIECE(VADM(2),"^")
- SET PSOTRDFN=$SELECT(PSOTRDFN]"":PSOTRDFN,1:"Unavailable")
- SET Y=DT
- XECUTE ^DD("DD")
- SET EDT=Y
- +1 WRITE ?54,VADM(1)_" "_EDT
- +2 WRITE !
- IF PRCOPAY
- IF $GET(PSOBARS)
- SET X="S"
- SET X2=PSOTRDFN
- SET X1=$X
- WRITE ?54,@PSOBAR1,PSOTRDFN,@PSOBAR0,$CHAR(13)
- SET $X=0
- +3 IF PRCOPAY
- IF '$GET(PSOBARS)
- WRITE !!!
- +4 IF 'PRCOPAY
- WRITE !
- +5 IF 'PSSUFLG
- DO PRSUS
- DO NPP1
- GOTO END
- +6 SET (PSNONARR,PSNOADDR,PSNOBOTH)=0
- FOR TTT=1:1
- IF $GET(PSNOBOTH)
- QUIT
- Begin DoDot:1
- +7 WRITE $GET(^TMP($JOB,"PSOMAIL",TTT))
- IF '$ORDER(^(TTT))
- SET PSNOADDR=1
- +8 WRITE ?54,$GET(^TMP($JOB,"PSONARR",TTT)),!
- IF '$ORDER(^(TTT))
- SET PSNONARR=1
- +9 IF PSNOADDR
- IF PSNONARR
- SET PSNOBOTH=1
- End DoDot:1
- +10 DO NPP1
- END KILL ^TMP($JOB,"PSONARR"),^TMP($JOB,"PSOMAIL"),^TMP($JOB,"PSOSUSP"),^UTILITY($JOB,"W")
- +1 KILL DIWF,DIWL,DIWR,EDT,LLL,PRCOPAY,PS,PSNACNT,PSNOADDR,PSNOBOTH,PSNONARR,PSNOSUSP,PSNTHREE,PSOLGTH,PSOSD,PSOTRAIL,PSOTRDFN,PSSEVFL,PSSIXFL,PSSPCNT,PSSSRX,PSSUFLG,RXX,SPDATE,SPNUM,SPPL,STATE,TTT,VAADDR1,VADM,VAEL,VAPA,VASTREET,ZZ,ZZZ
- WRITE @IOF
- +2 IF $PIECE(PSOPAR,"^",31)
- DO BLANK^PSOLBLD
- WRITE @IOF
- +3 QUIT
- NPP1 ;
- +1 NEW PSOLAN
- SET PSOLAN=$PIECE($GET(^PS(55,DFN,"LAN")),"^",2)
- IF 'PSOLAN
- SET PSOLAN=1
- +2 IF $GET(PSOLAN)=1
- Begin DoDot:1
- +3 WRITE !,"The VA Notice of Privacy Practices, IB 10-163, which outlines your privacy",!
- +4 WRITE "rights, is available online at http://www1.va.gov/Health/ or you may obtain",!
- +5 WRITE "a copy by writing the VHA Privacy Office (19F2), 810 Vermont Avenue NW,",!
- +6 WRITE "Washington, DC 20420.",!
- End DoDot:1
- +7 IF $GET(PSOLAN)=2
- Begin DoDot:1
- +8 WRITE !,"La Notificacion relacionada con las Politicas de Privacidad del Departamento",!
- +9 WRITE "de Asuntos del Veterano, IB 10-163, contiene los detalles acerca de sus",!
- +10 WRITE "derechos de privacidad y esta disponible electronicamente en la siguiente",!
- +11 WRITE "direccion: http://www1.va.gov/Health/. Usted tambien puede conseguir una",!
- +12 WRITE "copia escribiendo a la Oficina de Privacidad del Departamento de Asuntos de",!
- +13 WRITE "Salud del Veterano, (19F2), 810 Vermont Avenue NW, Washington, DC 20420.",!
- End DoDot:1
- +14 QUIT
- +15 ;
- PRSUS SET (PSNONARR,PSNOADDR,PSNOSUSP,PSNTHREE)=0
- FOR TTT=1:1
- IF $GET(PSNTHREE)
- QUIT
- Begin DoDot:1
- +1 WRITE $GET(^TMP($JOB,"PSOMAIL",TTT))
- IF '$ORDER(^(TTT))
- SET PSNOADDR=1
- +2 WRITE ?54,$GET(^TMP($JOB,"PSONARR",TTT))
- IF '$ORDER(^(TTT))
- SET PSNONARR=1
- +3 WRITE ?102,$GET(^TMP($JOB,"PSOSUSP",TTT)),!
- IF '$ORDER(^(TTT))
- SET PSNOSUSP=1
- +4 IF PSNOADDR
- IF PSNONARR
- IF PSNOSUSP
- SET PSNTHREE=1
- End DoDot:1
- +5 QUIT
