- 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/PSORN52A.m
r613 r623 1 PSORN52A ;IHS/DSD/JCM/SAB/FLS-Break up of PSORN52 ;08/09/93 2 ;;7.0;OUTPATIENT PHARMACY;**157,148,268,225**;DEC 1997;Build 29 3 Q ; Call from tag 4 ; 5 IBHLD ; 6 I $P(PSOIBHLD,"^",2)="" S $P(PSOIBHLD,"^",2)=$S($P(PSOLDIBQ,"^",2)=1:1,$P(PSOLDIBQ,"^",2)=0:0,1:"") 7 I $P(PSOIBHLD,"^",3)="" S $P(PSOIBHLD,"^",3)=$S($P(PSOLDIBQ,"^",3)=1:1,$P(PSOLDIBQ,"^",3)=0:0,1:"") 8 I $P(PSOIBHLD,"^",4)="" S $P(PSOIBHLD,"^",4)=$S($P(PSOLDIBQ,"^",4)=1:1,$P(PSOLDIBQ,"^",4)=0:0,1:"") 9 I $P(PSOIBHLD,"^",5)="" S $P(PSOIBHLD,"^",5)=$S($P(PSOLDIBQ,"^",5)=1:1,$P(PSOLDIBQ,"^",5)=0:0,1:"") 10 I $P(PSOIBHLD,"^",6)="" S $P(PSOIBHLD,"^",6)=$S($P(PSOLDIBQ,"^",6)=1:1,$P(PSOLDIBQ,"^",6)=0:0,1:"") 11 I $P(PSOIBHLD,"^",7)="" S $P(PSOIBHLD,"^",7)=$S($P(PSOLDIBQ,"^",7)=1:1,$P(PSOLDIBQ,"^",7)=0:0,1:"") 12 I $P(PSOIBHLD,"^",8)="" S $P(PSOIBHLD,"^",8)=$S($P(PSOLDIBQ,"^",8)=1:1,$P(PSOLDIBQ,"^",8)=0:0,1:"") 13 Q 14 ; 15 FILE ; - Filling ^PSRX and ^PS(55 entries 16 S PSOX("NRX0")=PSORENW("RX0"),PSOX("NRX2")=PSORENW("RX2"),PSOX("NRX3")=PSORENW("RX3"),$P(PSOX("NRX3"),"^",5)="" 17 S $P(PSOX("NRX0"),"^")=PSOX("NRX #") S:$G(PSOX("PROVIDER"))]"" $P(PSOX("NRX0"),"^",4)=PSOX("PROVIDER") 18 I $G(PSORNSPD),$G(PSOX("PATIENT STATUS")),$G(PSOX("PATIENT STATUS"))?.N S $P(PSOX("NRX0"),"^",3)=PSOX("PATIENT STATUS") 19 S:$G(PSOX("COSIGNING PROVIDER"))]"" $P(PSOX("NRX3"),"^",3)=PSOX("COSIGNING PROVIDER") 20 S $P(PSOX("NRX0"),"^",5)=PSOX("CLINIC"),$P(PSOX("NRX0"),"^",9)=PSOX("# OF REFILLS") 21 I $G(PSOX("DAYS SUPPLY")) S $P(PSOX("NRX0"),"^",8)=PSOX("DAYS SUPPLY") 22 I $G(PSOX("QTY")) S $P(PSOX("NRX0"),"^",7)=PSOX("QTY") 23 S $P(PSOX("NRX0"),"^",11)=$S(PSOX("FILL DATE")>DT&($P(PSOPAR,"^",6)):"M",$D(PSOX("MAIL/WINDOW")):PSOX("MAIL/WINDOW"),1:$P(PSOX("NRX0"),"^",11)) 24 S $P(PSOX("NRX0"),"^",13)=PSOX("ISSUE DATE"),$P(PSOX("STA"),"^")=PSOX("STATUS"),$P(PSOX("NRX0"),"^",16)=$S($G(PSOX("CLERK CODE"))]"":PSOX("CLERK CODE"),1:DUZ) 25 S $P(PSOX("NRX0"),"^",17)=$G(PSODRUG("COST")) 26 S $P(PSOX("NRX2"),"^")=PSOX("LOGIN DATE"),$P(PSOX("NRX2"),"^",2)=PSOX("FILL DATE"),$P(PSOX("NRX2"),"^",3)="",$P(PSOX("NRX2"),"^",5)=PSOX("DISPENSED DATE") 27 S $P(PSOX("NRX2"),"^",6)=PSOX("STOP DATE"),$P(PSOX("NRX2"),"^",7)=$S($G(PSOX("NDC"))]"":PSOX("NDC"),1:$G(PSODRUG("NDC"))) 28 S $P(PSOX("NRX2"),"^",8)=$S($G(PSOX("MANUFACTURER"))]"":PSOX("MANUFACTURER"),1:$G(PSODRUG("MANUFACTURER"))) 29 S $P(PSOX("NRX2"),"^",9)=+PSOSITE,$P(PSOX("NRX2"),"^",10)="" 30 S $P(PSOX("NRX2"),"^",11)=$S($G(PSOX("EXPIRATION DATE"))]"":PSOX("EXPIRATION DATE"),1:$G(PSODRUG("EXPIRATION DATE"))) 31 S:$G(PSOX("GENERIC PROVIDER"))]"" $P(PSOX("NRX2"),"^",12)=PSOX("GENERIC PROVIDER") 32 S $P(PSOX("NRX2"),"^",13)="",$P(PSOX("NRX2"),"^",15)="",$P(PSOX("NRX3"),"^",4)=$P(PSOX("NRX3"),"^") 33 S $P(PSOX("EPH"),"^")=$S($G(PSOX("DAW"))]"":PSOX("DAW"),1:$G(PSODRUG("DAW"))) 34 ;S PSOX("LAST DISPENSED DATE")=$P(PSOX("NRX3"),"^") 35 S PSOX("LAST DISPENSED DATE")=PSOX("DISPENSED DATE") 36 S $P(PSOX("NRX3"),"^")=PSOX("LAST DISPENSED DATE") 37 S:$G(PSOX("NEXT POSSIBLE REFILL"))]"" $P(PSOX("NRX3"),"^",2)=PSOX("NEXT POSSIBLE REFILL") 38 S:'$P(^VA(200,$P(PSOX("NRX0"),"^",4),"PS"),"^",7) $P(PSOX("NRX3"),"^",3)="" 39 S:$G(PSOX("REMARKS"))']"" PSOX("REMARKS")="RENEWED FROM RX # "_$P(PSOX("RX0"),"^") 40 S $P(PSOX("NRX3"),"^",7)=PSOX("REMARKS"),$P(PSOX("NRX3"),"^",8)="" 41 ; 42 ; - File OTHER PATIENT INSTRUCTIONS into ^PSRX 43 I $G(PSOFXRNX) S PSOFXRN=1 44 D ^PSORN52C,FILE^PSORN52D 45 I $G(^PSRX(PSOX("OIRXN"),"INSS"))]"" S ^PSRX(PSOX("IRXN"),"INSS")=^PSRX(PSOX("OIRXN"),"INSS") K PSOX1 G F55 46 I $G(PSOX("SINS"))]"" S ^PSRX(PSOX("IRXN"),"INSS")=PSOX("SINS") 47 K PSOX1 48 ; 49 ; - File data into ^PS(55) 50 F55 L +^PS(55,PSODFN,"P"):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) S:'$D(^PS(55,PSODFN,"P",0)) ^(0)="^55.03PA^^" 51 F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1)) 52 S PSOX("55 IEN")=PSOX1 53 S ^PS(55,PSODFN,"P",PSOX1,0)=PSOX("IRXN"),$P(^PS(55,PSODFN,"P",0),"^",3,4)=PSOX1_"^"_($P(^PS(55,PSODFN,"P",0),"^",4)+1) 54 S ^PS(55,PSODFN,"P","A",PSOX("STOP DATE"),PSOX("IRXN"))="" 55 L -^PS(55,PSODFN,"P") 56 K PSOX1 57 ; 58 ; - Patient Counseling questions 59 I $G(OR0) D FULL^VALM1,COUN^PSONEW S PSONOOR="" 60 I $D(^XUSEC("PSORPH",DUZ)) S DA=PSOX("IRXN"),DIE=52,DR="41////"_PSOCOU_";S:'X Y=""@1"";42////"_PSOCOUU_";@1" D ^DIE K DIE,DR 61 ; 62 ; - Re-indexing file 52 entry 63 K DIK,DA S DIK="^PSRX(",DA=PSOX("IRXN") D IX1^DIK K DIK 64 S DA=PSOX("IRXN") D ORC^PSORN52C 65 Q 1 PSORN52A ;IHS/DSD/JCM/SAB/FLS-Break up of PSORN52 ;08/09/93 2 ;;7.0;OUTPATIENT PHARMACY;**157,148,268**;DEC 1997;Build 9 3 Q ; Call from tag 4 ; 5 IBHLD ; 6 I $P(PSOIBHLD,"^",2)="" S $P(PSOIBHLD,"^",2)=$S($P(PSOLDIBQ,"^",2)=1:1,$P(PSOLDIBQ,"^",2)=0:0,1:"") 7 I $P(PSOIBHLD,"^",3)="" S $P(PSOIBHLD,"^",3)=$S($P(PSOLDIBQ,"^",3)=1:1,$P(PSOLDIBQ,"^",3)=0:0,1:"") 8 I $P(PSOIBHLD,"^",4)="" S $P(PSOIBHLD,"^",4)=$S($P(PSOLDIBQ,"^",4)=1:1,$P(PSOLDIBQ,"^",4)=0:0,1:"") 9 I $P(PSOIBHLD,"^",5)="" S $P(PSOIBHLD,"^",5)=$S($P(PSOLDIBQ,"^",5)=1:1,$P(PSOLDIBQ,"^",5)=0:0,1:"") 10 I $P(PSOIBHLD,"^",6)="" S $P(PSOIBHLD,"^",6)=$S($P(PSOLDIBQ,"^",6)=1:1,$P(PSOLDIBQ,"^",6)=0:0,1:"") 11 I $P(PSOIBHLD,"^",7)="" S $P(PSOIBHLD,"^",7)=$S($P(PSOLDIBQ,"^",7)=1:1,$P(PSOLDIBQ,"^",7)=0:0,1:"") 12 Q 13 ; 14 FILE ; - Filling ^PSRX and ^PS(55 entries 15 S PSOX("NRX0")=PSORENW("RX0"),PSOX("NRX2")=PSORENW("RX2"),PSOX("NRX3")=PSORENW("RX3"),$P(PSOX("NRX3"),"^",5)="" 16 S $P(PSOX("NRX0"),"^")=PSOX("NRX #") S:$G(PSOX("PROVIDER"))]"" $P(PSOX("NRX0"),"^",4)=PSOX("PROVIDER") 17 I $G(PSORNSPD),$G(PSOX("PATIENT STATUS")),$G(PSOX("PATIENT STATUS"))?.N S $P(PSOX("NRX0"),"^",3)=PSOX("PATIENT STATUS") 18 S:$G(PSOX("COSIGNING PROVIDER"))]"" $P(PSOX("NRX3"),"^",3)=PSOX("COSIGNING PROVIDER") 19 S $P(PSOX("NRX0"),"^",5)=PSOX("CLINIC"),$P(PSOX("NRX0"),"^",9)=PSOX("# OF REFILLS") 20 I $G(PSOX("DAYS SUPPLY")) S $P(PSOX("NRX0"),"^",8)=PSOX("DAYS SUPPLY") 21 I $G(PSOX("QTY")) S $P(PSOX("NRX0"),"^",7)=PSOX("QTY") 22 S $P(PSOX("NRX0"),"^",11)=$S(PSOX("FILL DATE")>DT&($P(PSOPAR,"^",6)):"M",$D(PSOX("MAIL/WINDOW")):PSOX("MAIL/WINDOW"),1:$P(PSOX("NRX0"),"^",11)) 23 S $P(PSOX("NRX0"),"^",13)=PSOX("ISSUE DATE"),$P(PSOX("STA"),"^")=PSOX("STATUS"),$P(PSOX("NRX0"),"^",16)=$S($G(PSOX("CLERK CODE"))]"":PSOX("CLERK CODE"),1:DUZ) 24 S $P(PSOX("NRX0"),"^",17)=$G(PSODRUG("COST")) 25 S $P(PSOX("NRX2"),"^")=PSOX("LOGIN DATE"),$P(PSOX("NRX2"),"^",2)=PSOX("FILL DATE"),$P(PSOX("NRX2"),"^",3)="",$P(PSOX("NRX2"),"^",5)=PSOX("DISPENSED DATE") 26 S $P(PSOX("NRX2"),"^",6)=PSOX("STOP DATE"),$P(PSOX("NRX2"),"^",7)=$S($G(PSOX("NDC"))]"":PSOX("NDC"),1:$G(PSODRUG("NDC"))) 27 S $P(PSOX("NRX2"),"^",8)=$S($G(PSOX("MANUFACTURER"))]"":PSOX("MANUFACTURER"),1:$G(PSODRUG("MANUFACTURER"))) 28 S $P(PSOX("NRX2"),"^",9)=+PSOSITE,$P(PSOX("NRX2"),"^",10)="" 29 S $P(PSOX("NRX2"),"^",11)=$S($G(PSOX("EXPIRATION DATE"))]"":PSOX("EXPIRATION DATE"),1:$G(PSODRUG("EXPIRATION DATE"))) 30 S:$G(PSOX("GENERIC PROVIDER"))]"" $P(PSOX("NRX2"),"^",12)=PSOX("GENERIC PROVIDER") 31 S $P(PSOX("NRX2"),"^",13)="",$P(PSOX("NRX2"),"^",15)="",$P(PSOX("NRX3"),"^",4)=$P(PSOX("NRX3"),"^") 32 S $P(PSOX("EPH"),"^")=$S($G(PSOX("DAW"))]"":PSOX("DAW"),1:$G(PSODRUG("DAW"))) 33 ;S PSOX("LAST DISPENSED DATE")=$P(PSOX("NRX3"),"^") 34 S PSOX("LAST DISPENSED DATE")=PSOX("DISPENSED DATE") 35 S $P(PSOX("NRX3"),"^")=PSOX("LAST DISPENSED DATE") 36 S:$G(PSOX("NEXT POSSIBLE REFILL"))]"" $P(PSOX("NRX3"),"^",2)=PSOX("NEXT POSSIBLE REFILL") 37 S:'$P(^VA(200,$P(PSOX("NRX0"),"^",4),"PS"),"^",7) $P(PSOX("NRX3"),"^",3)="" 38 S:$G(PSOX("REMARKS"))']"" PSOX("REMARKS")="RENEWED FROM RX # "_$P(PSOX("RX0"),"^") 39 S $P(PSOX("NRX3"),"^",7)=PSOX("REMARKS"),$P(PSOX("NRX3"),"^",8)="" 40 ; 41 ; - File OTHER PATIENT INSTRUCTIONS into ^PSRX 42 I $G(PSOFXRNX) S PSOFXRN=1 43 D ^PSORN52C,FILE^PSORN52D 44 I $G(^PSRX(PSOX("OIRXN"),"INSS"))]"" S ^PSRX(PSOX("IRXN"),"INSS")=^PSRX(PSOX("OIRXN"),"INSS") K PSOX1 G F55 45 I $G(PSOX("SINS"))]"" S ^PSRX(PSOX("IRXN"),"INSS")=PSOX("SINS") 46 K PSOX1 47 ; 48 ; - File data into ^PS(55) 49 F55 L +^PS(55,PSODFN,"P"):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) S:'$D(^PS(55,PSODFN,"P",0)) ^(0)="^55.03PA^^" 50 F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1)) 51 S PSOX("55 IEN")=PSOX1 52 S ^PS(55,PSODFN,"P",PSOX1,0)=PSOX("IRXN"),$P(^PS(55,PSODFN,"P",0),"^",3,4)=PSOX1_"^"_($P(^PS(55,PSODFN,"P",0),"^",4)+1) 53 S ^PS(55,PSODFN,"P","A",PSOX("STOP DATE"),PSOX("IRXN"))="" 54 L -^PS(55,PSODFN,"P") 55 K PSOX1 56 ; 57 ; - Patient Counseling questions 58 I $G(OR0) D FULL^VALM1,COUN^PSONEW S PSONOOR="" 59 I $D(^XUSEC("PSORPH",DUZ)) S DA=PSOX("IRXN"),DIE=52,DR="41////"_PSOCOU_";S:'X Y=""@1"";42////"_PSOCOUU_";@1" D ^DIE K DIE,DR 60 ; 61 ; - Re-indexing file 52 entry 62 K DIK,DA S DIK="^PSRX(",DA=PSOX("IRXN") D IX1^DIK K DIK 63 S DA=PSOX("IRXN") D ORC^PSORN52C 64 Q
Note:
See TracChangeset
for help on using the changeset viewer.