PSOPXRMU.m

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