source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOUTIL.m@ 729

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1PSOUTIL ;IHS/DSD/JCM - outpatient pharmacy utility routine ; 03/28/93 20:46
2 ;;7.0;OUTPATIENT PHARMACY;**64**;DEC 1997
3 W !!,$C(7),"This routine not callable from PSOUTIL.."
4 Q
5 ;
6NPSOSD(PSORX) ; Entry point to add newly added rx to patients PSOSD array
7 S STA="ACTIVE^NON-VERIFIED^R^HOLD^NON-VERIFIED^ACTIVE^^^^^^ACTIVE^DISCONTINUE^^DISCONTINUE^DISCONTINUE^HOLD"
8 S STAT=$P(STA,"^",$P(^PSRX(PSORX("IRXN"),"STA"),"^")+1)
9 I $D(PSOSD(STAT,PSODRUG("NAME"))),$P(PSOSD(STAT,PSODRUG("NAME")),"^",2)<10 D
10 . S PSOSD(STAT,PSODRUG("NAME")_"^"_PSORX("IRXN"))=PSORX("IRXN")_"^"_$P($G(^PSRX(PSORX("IRXN"),"STA")),"^")_"^^^"_PSODRUG("VA CLASS")_"^"_$P(^PSRX(PSORX("IRXN"),0),"^",9)_"^"_PSODRUG("NDF")_"^"_$P(^PSRX(PSORX("IRXN"),0),"^",8)_"^1"
11 E S PSOSD(STAT,PSODRUG("NAME"))=PSORX("IRXN")_"^"_$P($G(^PSRX(PSORX("IRXN"),"STA")),"^")_"^^^"_PSODRUG("VA CLASS")_"^"_$P(^PSRX(PSORX("IRXN"),0),"^",9)_"^"_PSODRUG("NDF")_"^"_$P(^PSRX(PSORX("IRXN"),0),"^",8)_"^1"
12 S PSOSD=$S($G(PSOSD)]"":PSOSD+1,1:1),^TMP("PS",$J,STAT,PSODRUG("NAME"))=1
13 Q
14 ;
15RNPSOSD ;update PSOSD array for renewals
16 S STA="ACTIVE^NON-VERIFIED^R^HOLD^NON-VERIFIED^ACTIVE^^^^^^ACTIVE^DISCONTINUE^^DISCONTINUE^DISCONTINUE^HOLD"
17 S STAT=$P(STA,"^",$P(^PSRX(PSORENW("OIRXN"),"STA"),"^")+1)
18 I $D(PSOSD(STAT,PSODRUG("NAME")_"^"_PSORENW("OIRXN"))) D
19 . S PSOSD(STAT,PSODRUG("NAME")_"^"_PSORENW("IRXN"))=PSOSD(STAT,PSODRUG("NAME")_"^"_PSORENW("OIRXN")),$P(PSOSD(STAT,PSODRUG("NAME")_"^"_PSORENW("IRXN")),"^",2)=$P($G(^PSRX(PSORENW("IRXN"),"STA")),"^")
20 . S $P(PSOSD(STAT,PSODRUG("NAME")_"^"_PSORENW("IRXN")),"^",6)=$P(^PSRX(PSORENW("IRXN"),0),"^",9)
21 . K PSOSD(STAT,PSODRUG("NAME")_"^"_PSORENW("OIRXN")) Q
22 E D
23 .S $P(PSOSD(STAT,PSODRUG("NAME")),"^")=PSORENW("IRXN"),$P(PSOSD(STAT,PSODRUG("NAME")),"^",2)=$P($G(^PSRX(PSORENW("IRXN"),"STA")),"^")
24 .S $P(PSOSD(STAT,PSODRUG("NAME")),"^",6)=$P(^PSRX(PSORENW("IRXN"),0),"^",9)
25 .S ^TMP("PS",$J,STAT,PSODRUG("NAME"))=1
26 Q
27 ;
28PROV(PSORENW) ;called from psoornew
29CHKPRV ;check inactive providers and cosinging providers called from PSORENW (renew rx)
30 I '$D(^VA(200,PSORENW("PROVIDER"),0)) D G:PSORENW("DFLG") CHKPRVX
31 .W !,$C(7),"Provider not in New Person File .. You must select a new provider"
32 .S PSODIR("FIELD")=0 K PSORENW("PROVIDER") D PROV^PSODIR(.PSORENW)
33 .S:$G(PSORENW("PROVIDER"))']"" PSORENW("DFLG")=1
34 ;
35 I '$G(^VA(200,PSORENW("PROVIDER"),"PS")) D G:PSORENW("DFLG") CHKPRVX
36 .W !,$C(7),$P(^VA(200,PSORENW("PROVIDER"),0),"^")_" is not a Valid provider .. You must select a new provider"
37 .S PSODIR("FIELD")=0 K PSORENW("PROVIDER") D PROV^PSODIR(.PSORENW)
38 .S:$G(PSORENW("PROVIDER"))']"" PSORENW("DFLG")=1
39 ;
40 K PSOX S PSOX=$P($G(^VA(200,PSORENW("PROVIDER"),"PS")),"^",4)
41 I PSOX,PSOX<DT D G:PSORENW("DFLG") CHKPRVX
42 .W !,$C(7),$P(^VA(200,PSORENW("PROVIDER"),0),"^")_" is inactive as a provider .. You must select a new provider"
43 .S PSODIR("FIELD")=0 K PSORENW("PROVIDER") D PROV^PSODIR(.PSORENW)
44 .I $G(PSORENW("PROVIDER"))']"" S PSORENW("DFLG")=1
45 ;
46 I '$D(PSORENW("COSIGNING PROVIDER")),$D(PSORENW("COSIGNER")) K PSOX S PSOX=$P(^VA(200,PSORENW("COSIGNER"),"PS"),"^",4) I PSOX,PSOX<DT D
47 .W !,$C(7),"Inactive Cosigning Provider .. You must select a new cosigner"
48 .S PSODIR("FIELD")=0,PSODIR("PROVIDER")=$S($D(PSORENW("PROVIDER")):PSORENW("PROVIDER"),1:PSORENW("PROVIDER"))
49 .D COSIGN^PSODIR I '$D(PSODIR("COSIGNING PROVIDER")) S PSORENW("DFLG")=1
50 .S PSORENW("COSIGNING PROVIDER")=PSODIR("COSIGNING PROVIDER")
51 ;
52CHKPRVX K PSODIR,PSOX
53 Q
54 ;
55NEXT(PSOX) ;
56 S PSOX("RX0")=^PSRX(PSOX("IRXN"),0)
57 S PSOX("RX2")=^PSRX(PSOX("IRXN"),2)
58 S PSOX("RX3")=^PSRX(PSOX("IRXN"),3)
59 S PSOX1=$P(PSOX("RX2"),"^",2)
60 I '$O(^PSRX(PSOX("IRXN"),1,0)) D G NEXTX
61 . S $P(PSOX("RX3"),"^")=PSOX1,X1=PSOX1
62 . S X2=$P(PSOX("RX0"),"^",8)-10\1
63 . D C^%DTC
64 . S:'$P(PSOX("RX3"),"^",8) $P(PSOX("RX3"),"^",2)=X
65 . K X Q
66 ;
67 S PSOY2=0
68 F PSOY=0:0 S PSOY=$O(^PSRX(PSOX("IRXN"),1,PSOY)) Q:'PSOY S PSOY1=PSOY,PSOY2=PSOY2+1
69 S PSOY=^PSRX(PSOX("IRXN"),1,PSOY1,0)
70 S PSOX2=$P(PSOY,"^")
71 S $P(PSOX("RX3"),"^")=PSOX2,X1=PSOX2
72 S X2=$P(PSOX("RX0"),"^",8)-10\1
73 D C^%DTC S PSOY3=X
74 S X1=PSOX1,X2=(PSOY2+1)*$P(PSOX("RX0"),"^",8)-10\1
75 D C^%DTC S PSOY4=X
76 S $P(PSOX("RX3"),"^",2)=$S(PSOY3<PSOY4:PSOY4,1:PSOY3)
77NEXTX ;
78 K X,PSOX1,PSOX2,PSOY,PSOY1,PSOY2,PSOY3,PSOY4
79 Q
80 ;
81SUSDATE(PSOX) ;
82 S PSOX("OLD FILL DATE")=PSOX("FILL DATE")
83 S PSORX("OLD FILL DATE")=PSORX("FILL DATE")
84 S PSOX("FILL DATE")=$P(PSOX("RX3"),"^",2)
85 I $O(^PS(52.5,"B",PSOX("IRXN"),0)),'$G(^PS(52.5,+$O(^PS(52.5,"B",PSOX("IRXN"),0)),"P")) S PSOX("FILL DATE")=$P(PSOX("RX3"),"^")
86 S Y=PSOX("FILL DATE")
87 X ^DD("DD") S PSORX("FILL DATE")=Y K Y
88 Q
89 ;
90SUSDATEK(PSOX) ;
91 S PSOX("FILL DATE")=PSOX("OLD FILL DATE")
92 I $G(PSORX("OLD FILL DATE"))="",$G(PSORENW("OLD FILL DATE")) S Y=PSORENW("OLD FILL DATE") D DD^%DT S PSORX("OLD FILL DATE")=Y K Y
93 S PSORX("FILL DATE")=PSORX("OLD FILL DATE")
94 K PSOX("OLD FILL DATE"),PSORX("OLD FILL DATE")
95 Q
96 ;
97STATUS(PSOREA,PSOSTAT) ;
98 S DSMSG="Cannot "_$S($G(PSOOPT)=3:"renew",1:"refill")_" Rx. " S:$G(OR0) ACOM=DSMSG
99 I PSOREA["A" W:$G(SPEED) ", Inactive Drug.",! D
100 .S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"Inactive Drug.",VALMBCK="R" W:'$G(POERR) !," Inactive Drug"
101 .S:$G(OR0) ACOM=ACOM_" Inactive Drug."
102 I PSOREA["M" W:$G(SPEED) ", Drug no longer used by Outpatient.",! D
103 .S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"Drug no longer used by Outpatient.",VALMBCK="R" W:'$G(POERR) !," Drug no longer used by Outpatient."
104 .S:$G(OR0) ACOM=ACOM_" Drug no longer used by Outpatient."
105 ;
106 I PSOREA["B" W:$G(SPEED) ", Narcotic Drug." D
107 .W:'$G(POERR) !,"Narcotic Drug" S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"Narcotic Drug.",VALMBCK="R"
108 .S:$G(OR0) ACOM=ACOM_" Narcotic Drug."
109 ;
110 I PSOREA["C" W:$G(SPEED) ", Non-Renewable Drug." D
111 .W:'$G(POERR) !,"Non-Renewable Drug" S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"Non-Renewable Drug.",VALMBCK="R"
112 .S:$G(OR0) ACOM=ACOM_" Non-Renewable Drug."
113 ;
114 I PSOREA["D" W:$G(SPEED) ", Non-Renewable Patient Status." D
115 .W:'$G(POERR) !,"Non-Renewable Patient Status" S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"Non-Renewable Patient Status.",VALMBCK="R"
116 .S:$G(OR0) ACOM=ACOM_" Non-Renewable Patient Status."
117 ;
118 I PSOREA["E" W:$G(SPEED) ", Non-Verified Rx." D
119 .W:'$G(POERR) !,"Non-Verified Rx" S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"Non-Verified Rx.",VALMBCK="R"
120 .S:$G(OR0) ACOM=ACOM_" Non-Verified Rx."
121 ;
122 I PSOREA["F" W:$G(SPEED) ", Maximum of 26 Renewals." D
123 .W:'$G(POERR) !,"Maximum of 26 Renewals" S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"Maximum of 26 Renewals.",VALMBCK="R"
124 .S:$G(OR0) ACOM=ACOM_" Maximum of 26 Renewals."
125 ;
126 I PSOREA["G",PSOREA'["B" W:$G(SPEED) ", No more refills left." W:'$G(POERR) !,"No more refills left" S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"No more refills left.",VALMBCK="R"
127 ;
128 I PSOREA["Z" D
129 . S:PSOSTAT=4 PSOSTAT=1
130 . S PSOA=";"_PSOSTAT,PSOB=$P(^DD(52,100,0),"^",3),PSOA=$F(PSOB,PSOA),PSOA=$P($E(PSOB,PSOA,999),";",1)
131 . W:$G(SPEED) ", Rx is in "_$P(PSOA,":",2)_" status."
132 . W:'$G(POERR)&('$G(SPEED)) !,"Rx is in "_$P(PSOA,":",2)_" status"
133 .S:$G(POERR)&($G(VALMSG)']"")&('$G(SPEED)) VALMSG=DSMSG_"Rx is in "_$P(PSOA,":",2)_" status.",VALMBCK="R"
134 . K PSOA,PSOB
135 . Q
136 I $G(SPEED) K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIRUT,DUOUT,DTOUT,DIR
137 Q
138ACP I $P(^PSRX(PSOX("IRXN"),0),"^",11)="W",$G(^("IB")) S ^PSRX("ACP",$P(^PSRX(PSOX("IRXN"),0),"^",2),$P(^(2),"^",2),0,PSOX("IRXN"))=""
139 Q
140 ;
141RENFDT(PSOX) ;gets the correct fill date
142 S PSOX("OLD FILL DATE")=PSOX("FILL DATE")
143 S PSORX("OLD FILL DATE")=PSORX("FILL DATE")
144 S PSOX("FILL DATE")=$P(PSOX("RX3"),"^",2)
145 N RXY,LBL,SUPN,LBP,RF,RFN,RFD
146 S RXY=PSOX("IRXN"),RFN=0
147 I '$O(^PSRX(RXY,1,0)) D GFDT G SDTX
148 F RF=0:0 S RF=$O(^PSRX(RXY,1,RF)) Q:'RF S RFN=RF
149 S RF=^PSRX(RXY,1,RFN,0) D GFDT
150 I PSOX("FILL DATE")<DT,PSOX("FILL DATE")<PSORNW("FILL DATE") S PSOX("FILL DATE")=DT
151SDTX ;
152 S Y=PSOX("FILL DATE")
153 X ^DD("DD") S PSORX("FILL DATE")=Y K Y
154 Q
155GFDT ;
156 I 'RFN,$P(^PSRX(RXY,2),"^",13) Q
157 I RFN,$P(RF,"^",18) Q
158 F LBL=0:0 S LBL=$O(^PSRX(RXY,"L",LBL)) Q:'LBL I $P(^PSRX(RXY,"L",LBL,0),"^",2)=RFN S LBP=1 Q
159 Q:$G(LBP)
160 S SUPN=$O(^PS(52.5,"B",RXY,0))
161 I SUPN,$P($G(^PS(52.5,SUPN,0)),"^",7)="L"!($P($G(^(0)),"^",7)="X") Q
162 S:RFN RFD=$E($P(RF,"^"),1,7) S:'RFN RFD=$P(PSOX("RX3"),"^")
163 I SUPN,RFD,$D(^PS(52.5,"C",RFD,SUPN)),$G(^PS(52.5,SUPN,"P"))=1 Q
164 S PSOX("FILL DATE")=$P(PSOX("RX3"),"^")
165 Q
166 ;
Note: See TracBrowser for help on using the repository browser.