- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSORN52C.m
r613 r623 1 PSORN52C 2 ;;7.0;OUTPATIENT PHARMACY;**1,7,11,27,46,75,87,100,111,124,117,131,146,148,200,225**;DEC 1997;Build 29 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 ENT 26 27 28 29 30 31 TNT 32 33 34 35 36 ORC 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 I $G(PSOX("OIRXN")),'$G(COPY) S $P(^PSRX(PSOX("IRXN"),"OR1"),"^",3)=PSOX("OIRXN"),$P(^PSRX(PSOX("OIRXN"),"OR1"),"^",4)=PSOX("IRXN"),^PSRX("AQ",PSOX("IRXN"),PSOX("OIRXN"))="" K PRC 54 55 56 57 58 59 60 61 62 63 64 65 BBRX 66 67 68 69 70 71 SAVE 72 73 74 75 76 77 78 79 80 81 82 83 84 85 RESTORE 86 87 88 89 90 91 92 93 94 95 96 97 1 PSORN52C ;BIR/SAB-files renewal entries con't ;08/09/93 2 ;;7.0;OUTPATIENT PHARMACY;**1,7,11,27,46,75,87,100,111,124,117,131,146,148,200**;DEC 1997;Build 7 3 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789 4 S DIC="^PSRX(",DLAYGO=52,DIC(0)="L",X=PSOX("NRX #") K DD,DO 5 D FILE^DICN S PSOX("IRXN")=+Y K DLAYGO,X,Y,DIC,DD,DO 6 D:+$G(DGI) TECH^PSODGDGI ; L +^PSRX(PSOX("IRXN")):0 7 D:$G(^TMP("PSODAI",$J,0)) 8 .S $P(^PSRX(PSOX("IRXN"),3),"^",6)=1 9 .I $O(^TMP("PSODAI",$J,0)) S DAI=0 F S DAI=$O(^TMP("PSODAI",$J,DAI)) Q:'DAI D 10 ..S:'$D(^PSRX(PSOX("IRXN"),"DAI",0)) ^PSRX(PSOX("IRXN"),"DAI",0)="^52.03^^" S ^PSRX(PSOX("IRXN"),"DAI",DAI,0)=^TMP("PSODAI",$J,DAI,0) 11 ..S $P(^PSRX(PSOX("IRXN"),"DAI",0),"^",3)=+$P(^PSRX(PSOX("IRXN"),"DAI",0),"^",3)+1,$P(^(0),"^",4)=+$P(^(0),"^",4)+1 12 .K ^TMP("PSODAI",$J),DAI 13 S PSORN52(PSOX("IRXN"),0)=PSOX("NRX0"),PSORN52(PSOX("IRXN"),2)=PSOX("NRX2"),PSORN52(PSOX("IRXN"),3)=PSOX("NRX3") 14 S PSORN52(PSOX("IRXN"),"EPH")=PSOX("EPH") 15 S:'$G(PSOX("ENT")) PSORN52(PSOX("IRXN"),"SIG")=PSOX("SIG") 16 S PSORN52(PSOX("IRXN"),"STA")=PSOX("STA") 17 S:$G(PSOX("TN"))]"" PSORN52(PSOX("IRXN"),"TN")=PSOX("TN") 18 I $G(PSOX("METHOD OF PICK-UP"))]"",PSOX("FILL DATE")'>DT S PSORN52(PSOX("IRXN"),"MP")=PSOX("METHOD OF PICK-UP") 19 S PSORN52(PSOX("IRXN"),"TYPE")=0 20 S PSOX1="" F S PSOX1=$O(PSORN52(PSOX("IRXN"),PSOX1)) Q:PSOX1="" S ^PSRX(PSOX("IRXN"),PSOX1)=$G(PSORN52(PSOX("IRXN"),PSOX1)) 21 I $O(SIG(0)) D G ENT 22 .S II=0 F I=0:0 S I=$O(SIG(I)) Q:'I S ^PSRX(PSOX("IRXN"),"SIG1",I,0)=SIG(I),II=II+1 23 .S ^PSRX(PSOX("IRXN"),"SIG1",0)="^52.04A^"_II_"^"_II,$P(^PSRX(PSOX("IRXN"),"SIG"),"^",2)=1 K I,II 24 .S $P(^PSRX(PSOX("IRXN"),"SIG"),"^",2)=1 25 ENT S ^PSRX(PSOX("IRXN"),"POE")=1,^PSRX(PSOX("IRXN"),"INS")=$G(PSOX("INS")) 26 I $G(OR0) S:$P(OR0,"^",24) ^PSRX(PSOX("IRXN"),"PKI")=1 27 I $G(PSOX("SIG",1))]"",'$O(PSOX("SIG",1)) S ^PSRX(PSOX("IRXN"),"INS1",1,0)=PSOX("SIG",1),^PSRX(PSOX("IRXN"),"INS1",0)="^52.0115^1^1^"_DT_"^^" 28 I $O(^PSRX(PSOX("OIRXN"),"INS1",0)) D 29 .F D=0:0 S D=$O(^PSRX(PSOX("OIRXN"),"INS1",D)) Q:'D S ^PSRX(PSOX("IRXN"),"INS1",D,0)=^PSRX(PSOX("OIRXN"),"INS1",D,0) 30 .S ^PSRX(PSOX("IRXN"),"INS1",0)=^PSRX(PSOX("OIRXN"),"INS1",0) 31 TNT F I=1:1:PSOX("ENT") S ^PSRX(PSOX("IRXN"),6,I,0)=PSOX("DOSE",I)_"^"_$G(PSOX("DOSE ORDERED",I))_"^"_$G(PSOX("UNITS",I))_"^"_$G(PSOX("NOUN",I))_"^" D 32 .S ^PSRX(PSOX("IRXN"),6,I,0)=^PSRX(PSOX("IRXN"),6,I,0)_$G(PSOX("DURATION",I))_"^"_$G(PSOX("CONJUNCTION",I))_"^"_$G(PSOX("ROUTE",I))_"^"_$G(PSOX("SCHEDULE",I))_"^"_$G(PSOX("VERB",I)) 33 .I $G(PSOX("ODOSE",I))]"" S ^PSRX(PSOX("IRXN"),6,I,1)=PSOX("ODOSE",I) 34 S:$G(PSOX("ENT")) ^PSRX(PSOX("IRXN"),6,0)="^52.0113^"_PSOX("ENT")_"^"_PSOX("ENT") 35 Q 36 ORC ; 37 D MARK^PSOTPCAN 38 K PSORDEDT,GG,PSOHD,PSOID,PTST,PTDY,PTRF,RFCNT,RN,SEG1,SIG,SIGOK,DIC 39 K ST0,STA,STP,STR,JJ,LSI,MM,ORDG,ORIG,PHARMST,PSCAN,PSCNT,PSOI,GMRAL,DIC,DIE,HDR,IEN,NAME D KVA^VADPT 40 I $G(PSOFDR) D 41 .I $G(PKI1)=1,$G(PKIR)]"" D ACT^PSOPKIV1(PSOX("IRXN")) 42 .S $P(^PSRX(PSOX("IRXN"),"OR1"),"^",2)=$P(OR0,"^"),^PSRX("APL",$P(OR0,"^"),PSOX("IRXN"))="" 43 .I $P($G(^PS(52.41,+$G(ORD),"EXT")),"^")="" I $G(PSOSIGFL)!($G(PSODRUG("OI"))'=$P(OR0,"^",8)) K:'$G(PSOPRC) PRC K PHI 44 .I $O(PRC(0)) S T=0 F S T=$O(PRC(T)) Q:'T S ^PSRX(PSOX("IRXN"),"PRC",T,0)=PRC(T),^PSRX(PSOX("IRXN"),"PRC",0)="^^"_T_"^"_T_"^"_DT_"^" 45 .I $O(PHI(0)) S T=0 F S T=$O(PHI(T)) Q:'T S ^PSRX(PSOX("IRXN"),"PI",T,0)=PHI(T),^PSRX(PSOX("IRXN"),"PI",0)="^^"_T_"^"_T_"^"_DT_"^" 46 .I $G(PSOSIGFL)!($G(PSODRUG("OI"))'=$P(OR0,"^",8)) D S PSOI=1 Q 47 ..S POERR("PLACER")=$P(^PS(52.41,ORD,0),"^"),PSORDEDT=ORD 48 ..K ^PS(52.41,"AOR",PSODFN,+$P($G(^PS(52.41,ORD,"INI")),"^"),ORD) 49 ..S DA=ORD,DIK="^PS(52.41," D ^DIK 50 ..S $P(^PSRX(PSOX("IRXN"),"OR1"),"^")=$G(PSODRUG("OI")) 51 .E S $P(^PSRX(PSOX("IRXN"),"OR1"),"^")=$P(OR0,"^",8) 52 .D PSOUL^PSSLOCK(ORD_"S") S DIK="^PS(52.41,",DA=ORD D ^DIK K DIK,DA 53 S:$G(PSOX("OIRXN"))&('$G(COPY)) $P(^PSRX(PSOX("IRXN"),"OR1"),"^",3)=PSOX("OIRXN"),$P(^PSRX(PSOX("OIRXN"),"OR1"),"^",4)=PSOX("IRXN"),^PSRX("AQ",PSOX("IRXN"),PSOX("OIRXN"))="" 54 I $O(PRC(0)) S T=0 F S T=$O(PRC(T)) Q:'T S ^PSRX(PSOX("IRXN"),"PRC",T,0)=PRC(T),^PSRX(PSOX("IRXN"),"PRC",0)="^^"_T_"^"_T_"^"_DT_"^" 55 I $O(PHI(0)) S T=0 F S T=$O(PHI(T)) Q:'T S ^PSRX(PSOX("IRXN"),"PI",T,0)=PHI(T),^PSRX(PSOX("IRXN"),"PI",0)="^^"_T_"^"_T_"^"_DT_"^" 56 S $P(^PSRX(PSOX("IRXN"),"OR1"),"^",5)=DUZ 57 S $P(^PSRX(PSOX("IRXN"),"OR1"),"^",8)=$$NOW^XLFDT D 58 . N DA,DIK S DA=PSOX("IRXN"),DIK="^PSRX(",DIK(1)=38.3 D EN1^DIK K DIK,DA 59 S PHARMST="",$P(^PSRX(PSOX("IRXN"),"OR1"),"^")=$G(PSODRUG("OI")) 60 S RXN=PSOX("IRXN") D SAVE 61 S STAT=$S($G(OR0)]""&('$G(PSOI)):"SC",$G(PSOI):"RO",1:"SN") S PHARMST=$S('$G(PSORX("VERIFY")):"CM",1:"IP") ;D EN^PSOHLSN1(RXN,STAT,PHARMST,"",PSONOOR) 62 S ^TMP("PSORXN",$J,RXN)=STAT_"^"_PHARMST_"^"_PSONOOR D PSOL^PSSLOCK(RXN) 63 D RESTORE K PSORDEDT,PHI,PRC,STAT,COMM,PSOI,OR2,OR1,PHARMST,RXN,DRG,STA,ACT,OCXR,OCXD1,OCXDT,OCXI 64 Q 65 BBRX ;build bingo board Rx array; called by PSON52,PSOR52,PSORN52 66 I $G(BBRX(1))']"" S BBRX(1)=PSOX("IRXN")_"," Q 67 F PSOX1=0:0 S PSOX1=$O(BBRX(PSOX1)) Q:'PSOX1 S PSOX2=PSOX1 68 I $L(BBRX(PSOX2))+$L(PSOX("IRXN"))<220 S BBRX(PSOX2)=BBRX(PSOX2)_PSOX("IRXN")_"," 69 E S BBRX(PSOX2+1)=PSOX("IRXN")_"," 70 Q 71 SAVE ;this module will be used to save PSO arrays 72 K ^TMP("PSOLST",$J) F I=0:0 S I=$O(PSOLST(I)) Q:'I S ^TMP("PSOLST",$J,I,0)=PSOLST(I) 73 K ^TMP("PSOSD",$J) S (STA,DRG)="" F S STA=$O(PSOSD(STA)) Q:STA="" F S DRG=$O(PSOSD(STA,DRG)) Q:DRG="" S ^TMP("PSOSD",$J,STA,DRG)=PSOSD(STA,DRG) 74 I $G(PSOSD) S ^TMP("PSOSD",$J,0)=PSOSD 75 I $G(PSODRUG("NAME"))]"" K ^TMP("PSODRUG",$J) S STA="" F S STA=$O(PSODRUG(STA)) Q:STA="" S ^TMP("PSODRUG",$J,STA)=PSODRUG(STA) 76 I $G(PSOX("# OF REFILLS"))]"" K ^TMP("PSOX",$J),^TMP("PSORENW",$J),^TMP("PSONEW",$J),^TMP("PSORXED",$J) D 77 .S STA="" F S STA=$O(PSOX(STA)) Q:STA="" S ^TMP("PSOX",$J,STA)=$G(PSOX(STA)) D 78 ..I STA="OLD LAST RX#",$O(PSOX(STA,"")) K ^TMP("PSOX",$J,STA) S ^TMP("PSOX",$J,STA,$O(PSOX(STA,"")))=PSOX(STA,$O(PSOX(STA,""))) D Q 79 ...I $O(PSONEW(STA,"")) S ^TMP("PSONEW",$J,STA,$O(PSONEW(STA,"")))=PSONEW(STA,$O(PSONEW(STA,""))) 80 ...I $O(PSORENW(STA,"")) S ^TMP("PSORENW",$J,STA,$O(PSORENW(STA,"")))=PSORENW(STA,$O(PSORENW(STA,""))) 81 ...I $O(PSORXED(STA,"")) S ^TMP("PSORXED",$J,STA,$O(PSORXED(STA,"")))=PSORXED(STA,$O(PSORXED(STA,""))) 82 ..F ACT="PSORENW","PSONEW","PSORXED" I $G(@(ACT_"("""_STA_""")"))]"" S ^TMP(ACT,$J,STA)=@(ACT_"("""_STA_""")") 83 K PSOPTPST,PSOSD,PSONEW,PSOLST,PSORENW,PSORXED,PSODRUG 84 Q 85 RESTORE ;this module restore saved arrays 86 S STA=0 F S STA=$O(^TMP("PSOLST",$J,STA)) Q:'STA S PSOLST(STA)=^TMP("PSOLST",$J,STA,0) 87 I $G(^TMP("PSOSD",$J,0)) S PSOSD=$G(^TMP("PSOSD",$J,0)) 88 S (STA,DRG)="" F S STA=$O(^TMP("PSOSD",$J,STA)) Q:STA="" F S DRG=$O(^TMP("PSOSD",$J,STA,DRG)) Q:DRG="" S PSOSD(STA,DRG)=^TMP("PSOSD",$J,STA,DRG) 89 S STA="" F S STA=$O(^TMP("PSODRUG",$J,STA)) Q:STA="" S PSODRUG(STA)=^TMP("PSODRUG",$J,STA) 90 S STA="" F ACT="PSOX","PSORENW","PSONEW","PSORXED" D:$O(^TMP(ACT,$J,STA))]"" 91 .F S STA=$O(^TMP(ACT,$J,STA)) Q:STA="" I STA'="OLD LAST RX#" S @(ACT_"("""_STA_""")")=^TMP(ACT,$J,STA) 92 I $O(^TMP("PSOX",$J,"OLD LAST RX#","")) S PSOX("OLD LAST RX#",$O(^TMP("PSOX",$J,"OLD LAST RX#","")))=^TMP("PSOX",$J,"OLD LAST RX#",$O(^TMP("PSOX",$J,"OLD LAST RX#",""))) 93 I $O(^TMP("PSONEW",$J,"OLD LAST RX#","")) S PSONEW("OLD LAST RX#",$O(^TMP("PSONEW",$J,"OLD LAST RX#","")))=^TMP("PSONEW",$J,"OLD LAST RX#",$O(^TMP("PSONEW",$J,"OLD LAST RX#",""))) 94 I $O(^TMP("PSORENW",$J,"OLD LAST RX#","")) S PSORENW("OLD LAST RX#",$O(^TMP("PSORENW",$J,"OLD LAST RX#","")))=^TMP("PSORENW",$J,"OLD LAST RX#",$O(^TMP("PSORENW",$J,"OLD LAST RX#",""))) 95 I $O(^TMP("PSORXED",$J,"OLD LAST RX#","")) S PSORXED("OLD LAST RX#",$O(^TMP("PSORXED",$J,"OLD LAST RX#","")))=^TMP("PSORXED",$J,"OLD LAST RX#",$O(^TMP("PSORXED",$J,"OLD LAST RX#",""))) 96 K ^TMP("PSOSD",$J),^TMP("PSODRUG",$J),^TMP("PSOX",$J),^TMP("PSORENW",$J),^TMP("PSONEW",$J),^TMP("PSORXED",$J),^TMP("PSOLST",$J) 97 Q
Note:
See TracChangeset
for help on using the changeset viewer.
