PSORN52A ;IHS/DSD/JCM/SAB/FLS-Break up of PSORN52 ;06-Nov-2013 08:45;DU
;;7.0;OUTPATIENT PHARMACY;**157,148,268,225,306,1015,1017**;DEC 1997;Build 40
;Modified - IHS/MSC/PLS - 05/13/2010 - Line FILE+26, FILE+41 and KILLOCM EP
Q ; Call from tag
;
IBHLD ;
I $P(PSOIBHLD,"^",2)="" S $P(PSOIBHLD,"^",2)=$S($P(PSOLDIBQ,"^",2)=1:1,$P(PSOLDIBQ,"^",2)=0:0,1:"")
I $P(PSOIBHLD,"^",3)="" S $P(PSOIBHLD,"^",3)=$S($P(PSOLDIBQ,"^",3)=1:1,$P(PSOLDIBQ,"^",3)=0:0,1:"")
I $P(PSOIBHLD,"^",4)="" S $P(PSOIBHLD,"^",4)=$S($P(PSOLDIBQ,"^",4)=1:1,$P(PSOLDIBQ,"^",4)=0:0,1:"")
I $P(PSOIBHLD,"^",5)="" S $P(PSOIBHLD,"^",5)=$S($P(PSOLDIBQ,"^",5)=1:1,$P(PSOLDIBQ,"^",5)=0:0,1:"")
I $P(PSOIBHLD,"^",6)="" S $P(PSOIBHLD,"^",6)=$S($P(PSOLDIBQ,"^",6)=1:1,$P(PSOLDIBQ,"^",6)=0:0,1:"")
I $P(PSOIBHLD,"^",7)="" S $P(PSOIBHLD,"^",7)=$S($P(PSOLDIBQ,"^",7)=1:1,$P(PSOLDIBQ,"^",7)=0:0,1:"")
I $P(PSOIBHLD,"^",8)="" S $P(PSOIBHLD,"^",8)=$S($P(PSOLDIBQ,"^",8)=1:1,$P(PSOLDIBQ,"^",8)=0:0,1:"")
Q
;
FILE ; - Filling ^PSRX and ^PS(55 entries
S PSOX("NRX0")=PSORENW("RX0"),PSOX("NRX2")=PSORENW("RX2"),PSOX("NRX3")=PSORENW("RX3"),$P(PSOX("NRX3"),"^",5)=""
S $P(PSOX("NRX0"),"^")=PSOX("NRX #") S:$G(PSOX("PROVIDER"))]"" $P(PSOX("NRX0"),"^",4)=PSOX("PROVIDER")
I $G(PSORNSPD),$G(PSOX("PATIENT STATUS")),$G(PSOX("PATIENT STATUS"))?.N S $P(PSOX("NRX0"),"^",3)=PSOX("PATIENT STATUS")
S:$G(PSOX("COSIGNING PROVIDER"))]"" $P(PSOX("NRX3"),"^",3)=PSOX("COSIGNING PROVIDER")
S $P(PSOX("NRX0"),"^",5)=PSOX("CLINIC"),$P(PSOX("NRX0"),"^",9)=PSOX("# OF REFILLS")
I $G(PSOX("DAYS SUPPLY")) S $P(PSOX("NRX0"),"^",8)=PSOX("DAYS SUPPLY")
I $G(PSOX("QTY")) S $P(PSOX("NRX0"),"^",7)=PSOX("QTY")
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))
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)
S $P(PSOX("NRX0"),"^",17)=$G(PSODRUG("COST"))
S $P(PSOX("NRX2"),"^")=PSOX("LOGIN DATE"),$P(PSOX("NRX2"),"^",2)=PSOX("FILL DATE"),$P(PSOX("NRX2"),"^",3)="",$P(PSOX("NRX2"),"^",4)="",$P(PSOX("NRX2"),"^",5)=PSOX("DISPENSED DATE")
S $P(PSOX("NRX2"),"^",6)=PSOX("STOP DATE")
;IHS/MSC/MGH Patch 1017
S $P(PSOX("NRX2"),"^",7)=$S($G(PSOX("NDC"))]"":PSOX("NDC"),1:$G(PSODRUG("NDC")))
S PSOX("RXNORM")=$$RXNORM^APSPFNC1($P(PSOX("NRX2"),"^",7))
S $P(PSOX("NRX2"),"^",8)=$S($G(PSOX("MANUFACTURER"))]"":PSOX("MANUFACTURER"),1:$G(PSODRUG("MANUFACTURER")))
S $P(PSOX("NRX2"),"^",9)=+PSOSITE,$P(PSOX("NRX2"),"^",10)=""
S $P(PSOX("NRX2"),"^",11)=$S($G(PSOX("EXPIRATION DATE"))]"":PSOX("EXPIRATION DATE"),1:$G(PSODRUG("EXPIRATION DATE")))
S:$G(PSOX("GENERIC PROVIDER"))]"" $P(PSOX("NRX2"),"^",12)=PSOX("GENERIC PROVIDER")
S $P(PSOX("NRX2"),"^",13)="",$P(PSOX("NRX2"),"^",15)="",$P(PSOX("NRX3"),"^",4)=$P(PSOX("NRX3"),"^")
S $P(PSOX("EPH"),"^")=$S($G(PSOX("DAW"))]"":PSOX("DAW"),1:$G(PSODRUG("DAW")))
;S PSOX("LAST DISPENSED DATE")=$P(PSOX("NRX3"),"^")
S PSOX("LAST DISPENSED DATE")=PSOX("DISPENSED DATE")
S $P(PSOX("NRX3"),"^")=PSOX("LAST DISPENSED DATE")
S:$G(PSOX("NEXT POSSIBLE REFILL"))]"" $P(PSOX("NRX3"),"^",2)=PSOX("NEXT POSSIBLE REFILL")
S:'$P(^VA(200,$P(PSOX("NRX0"),"^",4),"PS"),"^",7) $P(PSOX("NRX3"),"^",3)=""
S:$G(PSOX("REMARKS"))']"" PSOX("REMARKS")="RENEWED FROM RX # "_$P(PSOX("RX0"),"^")
S $P(PSOX("NRX3"),"^",7)=PSOX("REMARKS"),$P(PSOX("NRX3"),"^",8)=""
; IHS/CIA/PLS - 01/07/04 - Add Lot #, AWP, BST, INSURER, DUR and TRIP values
S $P(PSOX("NRX2"),"^",4)=""
S:$G(APSPMAN)=1 $P(PSOX("NRX2"),"^",4)=$S($G(PSODRUG("LOT #"))]"":PSODRUG("LOT #"),1:"") ; Default
I $G(PSOX("LOT #"))]"" S $P(PSOX("NRX2"),"^",4)=PSOX("LOT #")
S $P(PSOX("NRX9999999"),"^",6)=$S($D(PSOX("AWP")):PSOX("AWP"),1:$G(PSODRUG("AWP")))
S $P(PSOX("NRX9999999"),"^",7)=$S($D(PSOX("BST")):PSOX("BST"),1:$G(PSOBILST))
S:$D(PSOX("INSURER")) $P(PSOX("NRX9999999"),"^",12)=PSOX("INSURER")
S:$D(PSOX("DUR")) $P(PSOX("NRX9999999"),"^",12)=PSOX("DUR")
S:$G(PSOX("TRIP"))]"" $P(PSOX("NRX9999999"),"^",14)=PSOX("TRIP")
;
; - File OTHER PATIENT INSTRUCTIONS into ^PSRX
I $G(PSOFXRNX) S PSOFXRN=1
D ^PSORN52C,FILE^PSORN52D
I $G(^PSRX(PSOX("OIRXN"),"INSS"))]"" S ^PSRX(PSOX("IRXN"),"INSS")=^PSRX(PSOX("OIRXN"),"INSS") K PSOX1 G F55
I $G(PSOX("SINS"))]"" S ^PSRX(PSOX("IRXN"),"INSS")=PSOX("SINS")
; IHS/CIA/PLS - 01/07/04 - Chronic Med Set
; 03/30/05 - Updated logic
N DIE,DA,DR
; IHS/CIA/PLS - 03/30/05 - Changed array name for CM
;I $G(PSOX("ZCM"))="Y" S DIE=52,DA=PSOX("IRXN"),DR="9999999.02///Y" D ^DIE
I $D(PSOX("CM")) S DIE=52,DA=PSOX("IRXN"),DR="9999999.02///"_$G(PSOX("CM")) D ^DIE
;IHS/CIA/PLS - 10/26/05 - Commented out next line and added the line after.
;K ^PS(55,PSODFN,"P","CP",PSOX("OIRXN"))
D KILLOCM(+PSOX("OIRXN"))
K PSOX1
;
; - File data into ^PS(55)
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^^"
F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1))
S PSOX("55 IEN")=PSOX1
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)
S ^PS(55,PSODFN,"P","A",PSOX("STOP DATE"),PSOX("IRXN"))=""
L -^PS(55,PSODFN,"P")
K PSOX1
;
; - Patient Counseling questions
I $G(OR0) D FULL^VALM1,COUN^PSONEW S PSONOOR=""
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
;
; - Re-indexing file 52 entry
K DIK,DA S DIK="^PSRX(",DA=PSOX("IRXN") D IX1^DIK K DIK
S DA=PSOX("IRXN") D ORC^PSORN52C
Q
; Remove Chronic Med flag for discontinued meds
; FileMan will clean up the xref in ^PS(55,PSDFN,"P","CP",DA)
KILLOCM(DA) ;EP - See above two lines for description
N DIE,DR
S DIE=52,DR="9999999.02///N" D ^DIE ;IHS/MSC/PLS - 01/25/10 - Changed from @ to N because of change to required field.
Q
PSORN52A ;IHS/DSD/JCM/SAB/FLS-Break up of PSORN52 ;06-Nov-2013 08:45;DU
+1 ;;7.0;OUTPATIENT PHARMACY;**157,148,268,225,306,1015,1017**;DEC 1997;Build 40
+2 ;Modified - IHS/MSC/PLS - 05/13/2010 - Line FILE+26, FILE+41 and KILLOCM EP
+3 ; Call from tag
QUIT
+4 ;
IBHLD ;
+1 IF $PIECE(PSOIBHLD,"^",2)=""
SET $PIECE(PSOIBHLD,"^",2)=$SELECT($PIECE(PSOLDIBQ,"^",2)=1:1,$PIECE(PSOLDIBQ,"^",2)=0:0,1:"")
+2 IF $PIECE(PSOIBHLD,"^",3)=""
SET $PIECE(PSOIBHLD,"^",3)=$SELECT($PIECE(PSOLDIBQ,"^",3)=1:1,$PIECE(PSOLDIBQ,"^",3)=0:0,1:"")
+3 IF $PIECE(PSOIBHLD,"^",4)=""
SET $PIECE(PSOIBHLD,"^",4)=$SELECT($PIECE(PSOLDIBQ,"^",4)=1:1,$PIECE(PSOLDIBQ,"^",4)=0:0,1:"")
+4 IF $PIECE(PSOIBHLD,"^",5)=""
SET $PIECE(PSOIBHLD,"^",5)=$SELECT($PIECE(PSOLDIBQ,"^",5)=1:1,$PIECE(PSOLDIBQ,"^",5)=0:0,1:"")
+5 IF $PIECE(PSOIBHLD,"^",6)=""
SET $PIECE(PSOIBHLD,"^",6)=$SELECT($PIECE(PSOLDIBQ,"^",6)=1:1,$PIECE(PSOLDIBQ,"^",6)=0:0,1:"")
+6 IF $PIECE(PSOIBHLD,"^",7)=""
SET $PIECE(PSOIBHLD,"^",7)=$SELECT($PIECE(PSOLDIBQ,"^",7)=1:1,$PIECE(PSOLDIBQ,"^",7)=0:0,1:"")
+7 IF $PIECE(PSOIBHLD,"^",8)=""
SET $PIECE(PSOIBHLD,"^",8)=$SELECT($PIECE(PSOLDIBQ,"^",8)=1:1,$PIECE(PSOLDIBQ,"^",8)=0:0,1:"")
+8 QUIT
+9 ;
FILE ; - Filling ^PSRX and ^PS(55 entries
+1 SET PSOX("NRX0")=PSORENW("RX0")
SET PSOX("NRX2")=PSORENW("RX2")
SET PSOX("NRX3")=PSORENW("RX3")
SET $PIECE(PSOX("NRX3"),"^",5)=""
+2 SET $PIECE(PSOX("NRX0"),"^")=PSOX("NRX #")
IF $GET(PSOX("PROVIDER"))]""
SET $PIECE(PSOX("NRX0"),"^",4)=PSOX("PROVIDER")
+3 IF $GET(PSORNSPD)
IF $GET(PSOX("PATIENT STATUS"))
IF $GET(PSOX("PATIENT STATUS"))?.N
SET $PIECE(PSOX("NRX0"),"^",3)=PSOX("PATIENT STATUS")
+4 IF $GET(PSOX("COSIGNING PROVIDER"))]""
SET $PIECE(PSOX("NRX3"),"^",3)=PSOX("COSIGNING PROVIDER")
+5 SET $PIECE(PSOX("NRX0"),"^",5)=PSOX("CLINIC")
SET $PIECE(PSOX("NRX0"),"^",9)=PSOX("# OF REFILLS")
+6 IF $GET(PSOX("DAYS SUPPLY"))
SET $PIECE(PSOX("NRX0"),"^",8)=PSOX("DAYS SUPPLY")
+7 IF $GET(PSOX("QTY"))
SET $PIECE(PSOX("NRX0"),"^",7)=PSOX("QTY")
+8 SET $PIECE(PSOX("NRX0"),"^",11)=$SELECT(PSOX("FILL DATE")>DT&($PIECE(PSOPAR,"^",6)):"M",$DATA(PSOX("MAIL/WINDOW")):PSOX("MAIL/WINDOW"),1:$PIECE(PSOX("NRX0"),"^",11))
+9 SET $PIECE(PSOX("NRX0"),"^",13)=PSOX("ISSUE DATE")
SET $PIECE(PSOX("STA"),"^")=PSOX("STATUS")
SET $PIECE(PSOX("NRX0"),"^",16)=$SELECT($GET(PSOX("CLERK CODE"))]"":PSOX("CLERK CODE"),1:DUZ)
+10 SET $PIECE(PSOX("NRX0"),"^",17)=$GET(PSODRUG("COST"))
+11 SET $PIECE(PSOX("NRX2"),"^")=PSOX("LOGIN DATE")
SET $PIECE(PSOX("NRX2"),"^",2)=PSOX("FILL DATE")
SET $PIECE(PSOX("NRX2"),"^",3)=""
SET $PIECE(PSOX("NRX2"),"^",4)=""
SET $PIECE(PSOX("NRX2"),"^",5)=PSOX("DISPENSED DATE")
+12 SET $PIECE(PSOX("NRX2"),"^",6)=PSOX("STOP DATE")
+13 ;IHS/MSC/MGH Patch 1017
+14 SET $PIECE(PSOX("NRX2"),"^",7)=$SELECT($GET(PSOX("NDC"))]"":PSOX("NDC"),1:$GET(PSODRUG("NDC")))
+15 SET PSOX("RXNORM")=$$RXNORM^APSPFNC1($PIECE(PSOX("NRX2"),"^",7))
+16 SET $PIECE(PSOX("NRX2"),"^",8)=$SELECT($GET(PSOX("MANUFACTURER"))]"":PSOX("MANUFACTURER"),1:$GET(PSODRUG("MANUFACTURER")))
+17 SET $PIECE(PSOX("NRX2"),"^",9)=+PSOSITE
SET $PIECE(PSOX("NRX2"),"^",10)=""
+18 SET $PIECE(PSOX("NRX2"),"^",11)=$SELECT($GET(PSOX("EXPIRATION DATE"))]"":PSOX("EXPIRATION DATE"),1:$GET(PSODRUG("EXPIRATION DATE")))
+19 IF $GET(PSOX("GENERIC PROVIDER"))]""
SET $PIECE(PSOX("NRX2"),"^",12)=PSOX("GENERIC PROVIDER")
+20 SET $PIECE(PSOX("NRX2"),"^",13)=""
SET $PIECE(PSOX("NRX2"),"^",15)=""
SET $PIECE(PSOX("NRX3"),"^",4)=$PIECE(PSOX("NRX3"),"^")
+21 SET $PIECE(PSOX("EPH"),"^")=$SELECT($GET(PSOX("DAW"))]"":PSOX("DAW"),1:$GET(PSODRUG("DAW")))
+22 ;S PSOX("LAST DISPENSED DATE")=$P(PSOX("NRX3"),"^")
+23 SET PSOX("LAST DISPENSED DATE")=PSOX("DISPENSED DATE")
+24 SET $PIECE(PSOX("NRX3"),"^")=PSOX("LAST DISPENSED DATE")
+25 IF $GET(PSOX("NEXT POSSIBLE REFILL"))]""
SET $PIECE(PSOX("NRX3"),"^",2)=PSOX("NEXT POSSIBLE REFILL")
+26 IF '$PIECE(^VA(200,$PIECE(PSOX("NRX0"),"^",4),"PS"),"^",7)
SET $PIECE(PSOX("NRX3"),"^",3)=""
+27 IF $GET(PSOX("REMARKS"))']""
SET PSOX("REMARKS")="RENEWED FROM RX # "_$PIECE(PSOX("RX0"),"^")
+28 SET $PIECE(PSOX("NRX3"),"^",7)=PSOX("REMARKS")
SET $PIECE(PSOX("NRX3"),"^",8)=""
+29 ; IHS/CIA/PLS - 01/07/04 - Add Lot #, AWP, BST, INSURER, DUR and TRIP values
+30 SET $PIECE(PSOX("NRX2"),"^",4)=""
+31 ; Default
IF $GET(APSPMAN)=1
SET $PIECE(PSOX("NRX2"),"^",4)=$SELECT($GET(PSODRUG("LOT #"))]"":PSODRUG("LOT #"),1:"")
+32 IF $GET(PSOX("LOT #"))]""
SET $PIECE(PSOX("NRX2"),"^",4)=PSOX("LOT #")
+33 SET $PIECE(PSOX("NRX9999999"),"^",6)=$SELECT($DATA(PSOX("AWP")):PSOX("AWP"),1:$GET(PSODRUG("AWP")))
+34 SET $PIECE(PSOX("NRX9999999"),"^",7)=$SELECT($DATA(PSOX("BST")):PSOX("BST"),1:$GET(PSOBILST))
+35 IF $DATA(PSOX("INSURER"))
SET $PIECE(PSOX("NRX9999999"),"^",12)=PSOX("INSURER")
+36 IF $DATA(PSOX("DUR"))
SET $PIECE(PSOX("NRX9999999"),"^",12)=PSOX("DUR")
+37 IF $GET(PSOX("TRIP"))]""
SET $PIECE(PSOX("NRX9999999"),"^",14)=PSOX("TRIP")
+38 ;
+39 ; - File OTHER PATIENT INSTRUCTIONS into ^PSRX
+40 IF $GET(PSOFXRNX)
SET PSOFXRN=1
+41 DO ^PSORN52C
DO FILE^PSORN52D
+42 IF $GET(^PSRX(PSOX("OIRXN"),"INSS"))]""
SET ^PSRX(PSOX("IRXN"),"INSS")=^PSRX(PSOX("OIRXN"),"INSS")
KILL PSOX1
GOTO F55
+43 IF $GET(PSOX("SINS"))]""
SET ^PSRX(PSOX("IRXN"),"INSS")=PSOX("SINS")
+44 ; IHS/CIA/PLS - 01/07/04 - Chronic Med Set
+45 ; 03/30/05 - Updated logic
+46 NEW DIE,DA,DR
+47 ; IHS/CIA/PLS - 03/30/05 - Changed array name for CM
+48 ;I $G(PSOX("ZCM"))="Y" S DIE=52,DA=PSOX("IRXN"),DR="9999999.02///Y" D ^DIE
+49 IF $DATA(PSOX("CM"))
SET DIE=52
SET DA=PSOX("IRXN")
SET DR="9999999.02///"_$GET(PSOX("CM"))
DO ^DIE
+50 ;IHS/CIA/PLS - 10/26/05 - Commented out next line and added the line after.
+51 ;K ^PS(55,PSODFN,"P","CP",PSOX("OIRXN"))
+52 DO KILLOCM(+PSOX("OIRXN"))
+53 KILL PSOX1
+54 ;
+55 ; - File data into ^PS(55)
F55 LOCK +^PS(55,PSODFN,"P"):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
IF '$DATA(^PS(55,PSODFN,"P",0))
SET ^(0)="^55.03PA^^"
+1 FOR PSOX1=$PIECE(^PS(55,PSODFN,"P",0),"^",3):1
IF '$DATA(^PS(55,PSODFN,"P",PSOX1))
QUIT
+2 SET PSOX("55 IEN")=PSOX1
+3 SET ^PS(55,PSODFN,"P",PSOX1,0)=PSOX("IRXN")
SET $PIECE(^PS(55,PSODFN,"P",0),"^",3,4)=PSOX1_"^"_($PIECE(^PS(55,PSODFN,"P",0),"^",4)+1)
+4 SET ^PS(55,PSODFN,"P","A",PSOX("STOP DATE"),PSOX("IRXN"))=""
+5 LOCK -^PS(55,PSODFN,"P")
+6 KILL PSOX1
+7 ;
+8 ; - Patient Counseling questions
+9 IF $GET(OR0)
DO FULL^VALM1
DO COUN^PSONEW
SET PSONOOR=""
+10 IF $DATA(^XUSEC("PSORPH",DUZ))
SET DA=PSOX("IRXN")
SET DIE=52
SET DR="41////"_PSOCOU_";S:'X Y=""@1"";42////"_PSOCOUU_";@1"
DO ^DIE
KILL DIE,DR
+11 ;
+12 ; - Re-indexing file 52 entry
+13 KILL DIK,DA
SET DIK="^PSRX("
SET DA=PSOX("IRXN")
DO IX1^DIK
KILL DIK
+14 SET DA=PSOX("IRXN")
DO ORC^PSORN52C
+15 QUIT
+16 ; Remove Chronic Med flag for discontinued meds
+17 ; FileMan will clean up the xref in ^PS(55,PSDFN,"P","CP",DA)
KILLOCM(DA) ;EP - See above two lines for description
+1 NEW DIE,DR
+2 ;IHS/MSC/PLS - 01/25/10 - Changed from @ to N because of change to required field.
SET DIE=52
SET DR="9999999.02///N"
DO ^DIE
+3 QUIT
