PSOPXRMU ;BHM/MFR - Set/Kill of Clinical Reminders Index;22-Oct-2012 09:44;DU
;;7.0;OUTPATIENT PHARMACY;**118,1015**;DEC 1997;Build 62
;Reference to ^PXRMINDX supported by DBIA 4114
; Modified - IHS/MSC/MGH - 10/22/2012 - ERX entry point added
;IHS/MSC/MGH added new entry point for e-prescribing
;
SKIDX(X,DA,NODE,CMD) ;Set/Kill Clinical Reminder Index
;Input: X(1) - DAYS SUPPLY, X(2)=RELEASED DATE/TIME
; DA - PRESCRIPTION file IEN
; NODE - "O":Original; "R":Refill; "P":Partial
; CMD - "S":Set; "K": Kill
;
N D0,DAS,DATE,DFN,DRUG,Z
S D0=$S(NODE="O":DA,1:DA(1))
S Z=$G(^PSRX(D0,0)),DFN=$P(Z,U,2),DRUG=$P(Z,U,6)
I DFN=""!(DRUG="") Q
S DATE=+$$FMADD^XLFDT(X(2),X(1))
S DAS=DA_";2"
S:NODE="R" DAS=DA(1)_";1;"_DA_";0"
S:NODE="P" DAS=DA(1)_";P;"_DA_";0"
;
I CMD="S" D
. S ^PXRMINDX(52,"IP",DRUG,DFN,X(2),DATE,DAS)=""
. S ^PXRMINDX(52,"PI",DFN,DRUG,X(2),DATE,DAS)=""
I CMD="K" D
. K ^PXRMINDX(52,"IP",DRUG,DFN,X(2),DATE,DAS)
. K ^PXRMINDX(52,"PI",DFN,DRUG,X(2),DATE,DAS)
Q
;
;=============================================
KNVA(X,DA) ;Delete index for NVA node.
N DAS,START,STOP
;Reference to ^PXRMINDX("55NVA" is supported by DBIA# 4114.
S START=$S(X(3)'="":X(3),1:X(2))
S STOP=$S(X(4)'="":X(4),1:"U"_DA(1))
S DAS=DA(1)_";NVA;"_DA_";0"
K ^PXRMINDX("55NVA","IP",X(1),DA(1),START,STOP,DAS)
K ^PXRMINDX("55NVA","PI",DA(1),X(1),START,STOP,DAS)
Q
;
;=============================================
SNVA(X,DA) ;Set index for NVA node
;X(1)=PHARMACY ORDERABLE ITEM,X(2)=DOCUMENTED DATE,
;X(3)=START DATE (optional), X(4)=DISCONTINUED DATE (optional)
;Reference to ^PXRMINDX(55 is supported by DBIA# 4114.
N DAS,START,STOP
S START=$S(X(3)'="":X(3),1:X(2))
S STOP=$S(X(4)'="":X(4),1:"U"_DA(1))
S DAS=DA(1)_";NVA;"_DA_";0"
S ^PXRMINDX("55NVA","IP",X(1),DA(1),START,STOP,DAS)=""
S ^PXRMINDX("55NVA","PI",DA(1),X(1),START,STOP,DAS)=""
Q
;
;=====================================================
ERX(X,DA,NODE,CMD) ;Set/Kill Clinical Reminder Index
;IHS/MSC/MGH new call for e-prescribing
;Input: X(1) - DAYS SUPPLY, X(2)=FILL DATE/TIME
; DA - PRESCRIPTION file IEN
; NODE - "O":Original; "R":Refill; "P":Partial
; CMD - "S":Set; "K": Kill
;
N D0,DAS,DATE,DFN,DRUG,Z,DAYS,REF
S D0=$S(NODE="O":DA,1:DA(1))
S Z=$G(^PSRX(D0,0)),DFN=$P(Z,U,2),DRUG=$P(Z,U,6)
;Do not set on in-house fills
I $P($G(^PSRX(D0,999999921)),U,3)="" Q
I DFN=""!(DRUG="") Q
;Set date to days supply X number of refills
S REF=$P(Z,U,9)+1
S DAYS=X(1)*REF
S DATE=+$$FMADD^XLFDT(X(2),DAYS)
S DAS=DA_";2"
S:NODE="R" DAS=DA(1)_";1;"_DA_";0"
S:NODE="P" DAS=DA(1)_";P;"_DA_";0"
;
I CMD="S" D
. S ^PXRMINDX(52,"IP",DRUG,DFN,X(2),DATE,DAS)=""
. S ^PXRMINDX(52,"PI",DFN,DRUG,X(2),DATE,DAS)=""
I CMD="K" D
. K ^PXRMINDX(52,"IP",DRUG,DFN,X(2),DATE,DAS)
. K ^PXRMINDX(52,"PI",DFN,DRUG,X(2),DATE,DAS)
Q
PSOPXRMU ;BHM/MFR - Set/Kill of Clinical Reminders Index;22-Oct-2012 09:44;DU
+1 ;;7.0;OUTPATIENT PHARMACY;**118,1015**;DEC 1997;Build 62
+2 ;Reference to ^PXRMINDX supported by DBIA 4114
+3 ; Modified - IHS/MSC/MGH - 10/22/2012 - ERX entry point added
+4 ;IHS/MSC/MGH added new entry point for e-prescribing
+5 ;
SKIDX(X,DA,NODE,CMD) ;Set/Kill Clinical Reminder Index
+1 ;Input: X(1) - DAYS SUPPLY, X(2)=RELEASED DATE/TIME
+2 ; DA - PRESCRIPTION file IEN
+3 ; NODE - "O":Original; "R":Refill; "P":Partial
+4 ; CMD - "S":Set; "K": Kill
+5 ;
+6 NEW D0,DAS,DATE,DFN,DRUG,Z
+7 SET D0=$SELECT(NODE="O":DA,1:DA(1))
+8 SET Z=$GET(^PSRX(D0,0))
SET DFN=$PIECE(Z,U,2)
SET DRUG=$PIECE(Z,U,6)
+9 IF DFN=""!(DRUG="")
QUIT
+10 SET DATE=+$$FMADD^XLFDT(X(2),X(1))
+11 SET DAS=DA_";2"
+12 IF NODE="R"
SET DAS=DA(1)_";1;"_DA_";0"
+13 IF NODE="P"
SET DAS=DA(1)_";P;"_DA_";0"
+14 ;
+15 IF CMD="S"
Begin DoDot:1
+16 SET ^PXRMINDX(52,"IP",DRUG,DFN,X(2),DATE,DAS)=""
+17 SET ^PXRMINDX(52,"PI",DFN,DRUG,X(2),DATE,DAS)=""
End DoDot:1
+18 IF CMD="K"
Begin DoDot:1
+19 KILL ^PXRMINDX(52,"IP",DRUG,DFN,X(2),DATE,DAS)
+20 KILL ^PXRMINDX(52,"PI",DFN,DRUG,X(2),DATE,DAS)
End DoDot:1
+21 QUIT
+22 ;
+23 ;=============================================
KNVA(X,DA) ;Delete index for NVA node.
+1 NEW DAS,START,STOP
+2 ;Reference to ^PXRMINDX("55NVA" is supported by DBIA# 4114.
+3 SET START=$SELECT(X(3)'="":X(3),1:X(2))
+4 SET STOP=$SELECT(X(4)'="":X(4),1:"U"_DA(1))
+5 SET DAS=DA(1)_";NVA;"_DA_";0"
+6 KILL ^PXRMINDX("55NVA","IP",X(1),DA(1),START,STOP,DAS)
+7 KILL ^PXRMINDX("55NVA","PI",DA(1),X(1),START,STOP,DAS)
+8 QUIT
+9 ;
+10 ;=============================================
SNVA(X,DA) ;Set index for NVA node
+1 ;X(1)=PHARMACY ORDERABLE ITEM,X(2)=DOCUMENTED DATE,
+2 ;X(3)=START DATE (optional), X(4)=DISCONTINUED DATE (optional)
+3 ;Reference to ^PXRMINDX(55 is supported by DBIA# 4114.
+4 NEW DAS,START,STOP
+5 SET START=$SELECT(X(3)'="":X(3),1:X(2))
+6 SET STOP=$SELECT(X(4)'="":X(4),1:"U"_DA(1))
+7 SET DAS=DA(1)_";NVA;"_DA_";0"
+8 SET ^PXRMINDX("55NVA","IP",X(1),DA(1),START,STOP,DAS)=""
+9 SET ^PXRMINDX("55NVA","PI",DA(1),X(1),START,STOP,DAS)=""
+10 QUIT
+11 ;
+12 ;=====================================================
ERX(X,DA,NODE,CMD) ;Set/Kill Clinical Reminder Index
+1 ;IHS/MSC/MGH new call for e-prescribing
+2 ;Input: X(1) - DAYS SUPPLY, X(2)=FILL DATE/TIME
+3 ; DA - PRESCRIPTION file IEN
+4 ; NODE - "O":Original; "R":Refill; "P":Partial
+5 ; CMD - "S":Set; "K": Kill
+6 ;
+7 NEW D0,DAS,DATE,DFN,DRUG,Z,DAYS,REF
+8 SET D0=$SELECT(NODE="O":DA,1:DA(1))
+9 SET Z=$GET(^PSRX(D0,0))
SET DFN=$PIECE(Z,U,2)
SET DRUG=$PIECE(Z,U,6)
+10 ;Do not set on in-house fills
+11 IF $PIECE($GET(^PSRX(D0,999999921)),U,3)=""
QUIT
+12 IF DFN=""!(DRUG="")
QUIT
+13 ;Set date to days supply X number of refills
+14 SET REF=$PIECE(Z,U,9)+1
+15 SET DAYS=X(1)*REF
+16 SET DATE=+$$FMADD^XLFDT(X(2),DAYS)
+17 SET DAS=DA_";2"
+18 IF NODE="R"
SET DAS=DA(1)_";1;"_DA_";0"
+19 IF NODE="P"
SET DAS=DA(1)_";P;"_DA_";0"
+20 ;
+21 IF CMD="S"
Begin DoDot:1
+22 SET ^PXRMINDX(52,"IP",DRUG,DFN,X(2),DATE,DAS)=""
+23 SET ^PXRMINDX(52,"PI",DFN,DRUG,X(2),DATE,DAS)=""
End DoDot:1
+24 IF CMD="K"
Begin DoDot:1
+25 KILL ^PXRMINDX(52,"IP",DRUG,DFN,X(2),DATE,DAS)
+26 KILL ^PXRMINDX(52,"PI",DFN,DRUG,X(2),DATE,DAS)
End DoDot:1
+27 QUIT
