source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOLLLH.m@ 1128

Last change on this file since 1128 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.1 KB
Line 
1PSOLLLH ;BIR/EJW - HIPAA/NCPDP LASER LABELS ;7/20/06 10:21am
2 ;;7.0;OUTPATIENT PHARMACY;**161,148,244,200**;DEC 1997;Build 7
3 ;
4 ;Reference to DUR1^BPSNCPD3 supported by DBIA 4560
5 ;
6 ;*244 ignore Rx status > 11
7 ;
8SIGLOG N PSOSEQ,J,RXF,RXY,RXN,RX,FIRST,DATE,BLNKLIN,RX2,FDT,BLNKLN2,LAST,CNT
9 D DEM^VADPT
10 S FIRST=1,LAST=0
11 I '$G(REPRINT) D NOWINDOW I NOWIN Q
12 K NOWIN
13 S $P(BLNKLN2," ",32)=" "
14 S $P(BLNKLIN,"_",32)="_"
15 F PSOSEQ=1:1:$L(PPL,",") S RX=$P(PPL,",",PSOSEQ) D
16 .I RX="" Q
17 .Q:$G(^PSRX(RX,"STA"))>11 ;*244
18 .S RXY=$G(^PSRX(RX,0)) I RXY="" Q
19 .S CNT=$G(CNT)+1
20 .S RX2=$G(^PSRX(RX,2)),FDT=$P(RX2,"^",2)
21 .I FIRST!(CNT#4=1) D HDR,BARC S FIRST=0
22 .S RXF=+$O(^PSRX(RX,1,"A"),-1)
23 .I RXF>0 I +^PSRX(RX,1,RXF,0)'<FDT S FDT=+^(0)
24 .S DATE=$E(FDT,1,7),Y=DATE X ^DD("DD") S DATE=Y
25 .S RXN=$P(RXY,"^")
26 .S T=RXN_" ("_(RXF)_") "
27 .N PSODRNM
28 .S PSODRNM=$$ZZ^PSOSUTL(RX)
29 .S T=T_$E(FDT,4,5)_"/"_$E(FDT,6,7)_"/"_$E(FDT,2,3)_" "_$E(PSODRNM,1,(27-$L(RXN))) D PRINT(T)
30 S LAST=1 D SIGN
31 I $D(ZTQUEUED) S ZTREQ="@"
32 Q
33 ;
34SIGN ;
35 I '$G(CNT) Q
36 N II
37 S II=CNT#4
38 I LAST,II>0 F J=1:1:(4-II) S T=" " D PRINT(T)
39 S PSOY=PSOY+10
40 S T="Pt. Sig."_BLNKLIN D PRINT(T)
41 S PSOY=PSOY+5
42 D PRINT($$PLANNM())
43 S PSOY=PSOY+15
44 S T="Relation_____ Counseling Refused__ Accepted__" D PRINT(T)
45 S PSOY=PSOY+10
46 S T=PNM_" "_$G(SSNP) D PRINT(T,1)
47 Q
48 ;
49HDR ;
50 I 'FIRST D SIGN W @IOF
51 I $G(PSOIO("BLH"))]"" X PSOIO("BLH")
52 S T="VAMC "_$P(PS,"^",7)_", "_STATE_" "_$G(PSOHZIP) D PRINT(T)
53 S T=$P(PS2,"^",2)_" Ph: "_$P(PS,"^",3)_"-"_$P(PS,"^",4)_" "_$G(PSONOW) D PRINT(T)
54 I $G(PSOIO("BLB"))]"" X PSOIO("BLB")
55 S XFONT=$E(PSOFONT,2,99)
56 N REPMSG
57 S REPMSG=BLNKLN2_"(REPRINT)"
58 S T="By signing below"_$S($G(REPRINT):REPMSG,1:"") D PRINT(T,1)
59 S T="you acknowledge receipt of the following Rx's" D PRINT(T,1)
60 S T=" " D PRINT(T)
61 S PSOY=PSOY-20
62 Q
63 ;
64PRINT(T,B) ;
65 S BOLD=$G(B)
66 I 'BOLD,$G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
67 I BOLD,$G(PSOIO(PSOFONT_"B"))]"" X PSOIO(PSOFONT_"B")
68 I $G(PSOIO("ST"))]"" X PSOIO("ST")
69 W T,!
70 I $G(PSOIO("ET"))]"" X PSOIO("ET")
71 I BOLD,$G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT) ;TURN OFF BOLDING
72 Q
73 ;
74QUEUE ; ENTRY POINT TO REPRINT SIGNATURE LOG
75 I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) Q
76 N REPRINT,PS,STATE,PS2,PSOHZIP
77 S PS=$S($D(^PS(59,PSOSITE,0)):^(0),1:"")
78 S PS2=$P(PS,"^")_"^"_$P(PS,"^",6)
79 I $P(PSOSYS,"^",4),$D(^PS(59,+$P($G(PSOSYS),"^",4),0)) S PS=^PS(59,$P($G(PSOSYS),"^",4),0)
80 S VAADDR1=$P(PS,"^"),VASTREET=$P(PS,"^",2),STATE=$S($D(^DIC(5,+$P(PS,"^",8),0)):$P(^(0),"^",2),1:"UNKNOWN")
81 S PSZIP=$P(PS,"^",5),PSOHZIP=$S(PSZIP["-":PSZIP,1:$E(PSZIP,1,5)_$S($E(PSZIP,6,9)]"":"-"_$E(PSZIP,6,9),1:""))
82 S REPRINT=1
83LRP W !! S DIC("S")="I $P($G(^(0)),""^"",2),$D(^(""STA"")),$P($G(^(""STA"")),""^"")<10",DIC="^PSRX(",DIC("A")="Reprint Signature Log for Prescription: ",DIC(0)="QEAZ" D ^DIC K P,DIC("A") I Y<0!("^"[X) D KILL Q
84 W !
85 S (PPL,RX)=+Y
86 N RXY
87 S RXY=$G(^PSRX(RX,0)) I RXY="" Q
88 S DFN=$P(RXY,"^",2)
89GETPT2 D DEM^VADPT S PNM=VADM(1)
90 I $P(VADM(6),"^",2)]"" D G LRP
91 .W $C(7),!!,PNM_" Died "_$P(VADM(6),"^",2)_".",!
92 D 6^VADPT,PID^VADPT6 S SSNP=$G(VA("BID"))
93Q1 W ! K POP,ZTSK S %ZIS("B")="",%ZIS="MNQ",%ZIS("A")="Select LABEL DEVICE: " D ^%ZIS S PSLION=ION K %ZIS("A")
94 I $G(POP) Q
95 I $G(IOST(0)),'$D(^%ZIS(2,IOST(0),55,"B","LL")) W !,"Must specify a laser labels printer for Signature Log Reprint" G Q1
96 I '$G(IOST(0)) W !,"Nothing queued to print." H 1 Q
97 D NOW^%DTC S Y=$P(%,"."),PSOFNOW=% X ^DD("DD") S PSONOW=Y
98 F G="PPL","REPRINT","PNM","STATE","PS2","PSOHZIP","PSOPAR","PSOSITE","PS","PSONOW","PSOSYS","SSNP" S:$D(@G) ZTSAVE(G)=""
99 S ZTRTN="DQ^PSOLLLH",ZTIO=PSLION,ZTDESC="Outpatient Pharmacy Signature Log Reprint",ZTDTH=$H,PDUZ=DUZ
100 D ^%ZISC,^%ZTLOAD W:$D(ZTSK) !!,"Signature Log Reprint queued",!! H 1 K G
101 G QUEUE
102 Q
103DQ N PSOBIO S (I,PSOIO)=0 F S I=$O(^%ZIS(2,IOST(0),55,I)) Q:'I S X0=$G(^(I,0)) I X0]"" S PSOIO($P(X0,"^"))=^(1),PSOIO=1
104 I $G(PSOIO("LLI"))]"" X PSOIO("LLI")
105 G SIGLOG
106 ;
107PLANNM() ; Returns Insurance Name (3rd Party)
108 S PLANNM=""
109 N I,DUR,RX
110 F I=1:1:$L(PPL,",") S RX=+$P(PPL,",",I) D I PLANNM'="" Q
111 .I 'RX Q
112 .D DUR1^BPSNCPD3(RX,$$LSTRFL^PSOBPSU1(RX),.DUR) S PLANNM=$G(DUR(1,"INSURANCE NAME"))
113 Q PLANNM
114BARC I '$G(FIRST) G BARCE ; PRINT BARCODE FOR 1 RX ON 1ST SIGLOG LABEL ONLY
115 I $G(PSOIO("BLBC"))]"" X PSOIO("BLBC") I $G(NOBARC) G BARCE
116 I '$D(PSOINST) D INST
117 S X2=PSOINST_"-"_RX W X2
118 I $G(PSOIO("EBLBC"))]"" X PSOIO("EBLBC")
119BARCE Q
120 ;
121KILL ; CLEAN UP VARIABLES
122 K DIC,DFN,PNM,PPL,PSZIP,RX,SSNP,VA,VADDR1,VADM,VAEL,VAPA,VASTREET
123 Q
124INST ;
125 K ^UTILITY("DIQ1",$J) S DA=$P($$SITE^VASITE(),"^")
126 I $G(DA) S DIC=4,DIQ(0)="I",DR="99" D EN^DIQ1 S PSOINST=$G(^UTILITY("DIQ1",$J,4,DA,99,"I"))
127 K ^UTILITY("DIQ1",$J),DA,DR,DIC
128 Q
129 ;
130NOWINDOW ; ON ORIGINAL PRINT - DON'T PRINT IF ALL ARE MAIL
131 N I,RX,RXF,MW,RXP,RXY
132 S NOWIN=1
133 F I=1:1:$L(PPL,",") S RX=$P(PPL,",",I) D I 'NOWIN Q
134 .I RX="" Q
135 .I $G(^PSRX(RX,"STA"))>11 Q
136 .S RXY=$G(^PSRX(RX,0)) I RXY="" Q
137 .I '$D(^PSRX(RX,1)) S MW=$P(RXY,"^",11) I MW="W" S NOWIN=0 Q
138 .S RXF=$O(^PSRX(RX,1,99),-1) I RXF>0 S MW=$P($G(^PSRX(RX,1,RXF,0)),"^",2) I MW="W" S NOWIN=0
139 .S RXP=$O(^PSRX(RX,"P",99),-1) I RXP>0 S MW=$P($G(^PSRX(RX,"P",RXP,0)),"^",2) I MW="W" S NOWIN=0
140 Q
Note: See TracBrowser for help on using the repository browser.