PSJHL6.m

PSJHL6 ;BIR/LDT-ACTIONS ON HL7 MESSAGES FROM OE/RR (CONT) ;02 Mar 99 / 9:26 AM

 ;;5.0; INPATIENT MEDICATIONS ;**1,11,27,34,40,42,51,59,88,98**;16 DEC 97

 ;

 ; Reference to EN^ORERR is supported by DBIA# 2187.

 ; Reference to ^PS(55 is supported by DBIA# 2191.

 ;

CANCEL ;Cancel or Discontinue orders thru OE/RR

 N DA,DR,DIE,STATUS,STPDT,NODE,NODE2,PSREASON,PSIVACT,PSIVALT,ON55,PSIVREA,PSIVALCK,P

 S NODE=$G(@(RXORDER_"0)")),NODE2=$G(@(RXORDER_"2)"))

 I 'NODE S PSREASON="Invalid Pharmacy order number" D  Q

 .S X="ORERR" X ^%ZOSF("TEST") I  D EN^ORERR(PSREASON_"/DC Msg",.PSJMSG)

 .D EN1^PSJHLERR(PSJHLDFN,$S(PSOC="CA":"UC",1:"UD"),$P(ORDER,U),PSREASON)

 I RXON["P",PSJHLDFN'=$P(NODE,U,15) S ORDCON="Patient does not match/Discontinue Msg" D  Q

 .S X="ORERR" X ^%ZOSF("TEST") I  D EN^ORERR(ORDCON,.PSJMSG)

 .D EN1^PSJHLERR(PSJHLDFN,$S(PSOC="CA":"UC",1:"UD"),$P(ORDER,U),ORDCON)

 S $P(@(RXORDER_"0)"),"^",21)=$P(ORDER,"^",1)

 S STATUS=$S(RXON["V":$P(NODE,"^",17),1:$P(NODE,"^",9))

 S STPDT=$S(RXON["V":$P(NODE,"^",3),1:$P(NODE2,"^",4))

 I "AHNOPR"'[STATUS D @STATUS S PSREASON=PSREASON_" orders may not be "_$S(PSOC="CA":"cancelled",1:"discontinued") D EN1^PSJHL2(PSJHLDFN,$S(PSOC="CA":"UC",1:"UD"),RXON,PSREASON) Q

 S:(RXON["A")!(RXON["U")!(RXON["V") DA(1)=PSJHLDFN,DA=+RXON

 D NOW^%DTC

 S DIE=$S(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",(RXON["N")!(RXON["P"):"^PS(53.1,",1:"^PS(55,"_PSJHLDFN_",5,"),DA=+RXON

 S DR=$S(RXON["V":"100////D;116////^S X=STPDT;.03////",(RXON["N")!(RXON["P"):"28////D;25////",1:"25////^S X=STPDT;28////D;34////")_$S($G(ORDCON)="A"&($G(PSJASTP)'=""):$G(PSJASTP),1:%)

 I RXON["A"!(RXON["U") S PSGAL("C")=$S($G(ORDCON)="A":1040,1:4000) D ^PSGAL5

 I RXON["V" S PSIVACT=1,PSIVALT=$S($G(ORDCON)="A":"",1:2),PSIVAL=$S($G(ORDCON)="A":"AUTO DISCONTINUED  (TREATING SPECIALTY TRANSFER)",1:""),ON55=RXON,PSIVREA="D",P(3)=STPDT

 S:$G(ORDCON)="A" DR=$S(RXON["V":DR_";121////1",RXON["N"!(RXON["P"):DR_";42////1",1:DR_";49////1")

 D ^DIE

 S:$G(ORDCON)="A" $P(^PS(55,PSJHLDFN,5.1),"^")=""

 I RXON["V" N DFN S DFN=PSJHLDFN D LOG^PSIVORAL

 D EN1^PSJHL2(PSJHLDFN,$S(PSOC="CA":"CR",1:"DR"),RXON)

 D NOW^%DTC I "ANR"[STATUS I STPDT<% D EXPIR Q

 D AUE(PSJHLDFN,RXON)

 Q

 ;

HOLD ;Place orders on hold thru OE/RR and check for expired orders

 N DA,DR,DIE,STATUS,STPDT,NODE,NODE2,PSREASON,PSIVACT,PSIVALT,PSIVREA,ON55

 S NODE=$G(@(RXORDER_"0)")),NODE2=$G(@(RXORDER_"2)"))

 I 'NODE S PSREASON="Invalid Pharmacy order number" D  Q

 .S X="ORERR" X ^%ZOSF("TEST") I  D EN^ORERR(PSREASON_"/Hold Msg",.PSJMSG)

 .D EN1^PSJHLERR(PSJHLDFN,"UH",$P(ORDER,U),PSREASON)

 S $P(@(RXORDER_"0)"),"^",21)=$P(ORDER,"^",1)

 S STATUS=$S(RXON["V":$P(NODE,"^",17),1:$P(NODE,"^",9))

 S STPDT=$S(RXON["V":$P(NODE,"^",3),1:$P(NODE2,"^",4))

 D NOW^%DTC I "ANR"[STATUS I STPDT<% D EXPIR

 I STATUS'="A" D @STATUS S PSREASON=PSREASON_" orders may not be placed on hold" D EN1^PSJHL2(PSJHLDFN,"UH",RXON,PSREASON) Q

 I STATUS="A" S DA(1)=PSJHLDFN,DA=+RXON,DIE=$S(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,"),DR=$S(RXON["V":"100////H;120////1;149////1",1:"28////H;56////1;59////A;59.1////1;60////@;61////@;62////@;58////"_%)

 I RXON["A"!(RXON["U") S PSGAL("C")=8500 D ^PSGAL5

 S:RXON["V" PSIVACT=1,PSIVALT=2,PSIVREA="H",ON55=RXON

 D ^DIE

 I RXON["V" N DFN S DFN=PSJHLDFN D LOG^PSIVORAL

 D EN1^PSJHL2(PSJHLDFN,"HR",RXON)

 D NOW^%DTC I "ANR"[STATUS I STPDT<% D EXPIR Q

 D AUE(PSJHLDFN,RXON)

 Q

 ;

UNHOLD ;Change status of orders palced on hold thru OE/RR & check for expired orders

 N DA,DR,DIE,STATUS,STPDT,NODE,NODE2,NODE4,HFLAG,PSREASON,PSIVACT,PSIVALT,PSIVREA,ON55

 S NODE=$G(@(RXORDER_"0)")),NODE2=$G(@(RXORDER_"2)")),NODE4=$G(@(RXORDER_"4)"))

 I 'NODE S PSREASON="Invalid Pharmacy order number" D  Q

 .S X="ORERR" X ^%ZOSF("TEST") I  D EN^ORERR(PSREASON_"/Unhold Msg",.PSJMSG)

 .D EN1^PSJHLERR(PSJHLDFN,"UR",$P(ORDER,U),PSREASON)

 S $P(@(RXORDER_"0)"),"^",21)=$P(ORDER,"^",1)

 S STATUS=$S(RXON["V":$P(NODE,"^",17),1:$P(NODE,"^",9))

 S STPDT=$S(RXON["V":$P(NODE,"^",3),1:$P(NODE2,"^",4))

 S HFLAG=$S(RXON["V":$P(NODE,"^",10),1:$P(NODE4,"^",26))

 I 'HFLAG S PSREASON="Orders placed on hold by Pharmacy may not be removed from hold through CPRS." D EN1^PSJHL2(PSJHLDFN,"UR",RXON,PSREASON) Q

 I "H"'[STATUS D @STATUS S PSREASON=PSREASON_" orders may not be taken off hold" D EN1^PSJHL2(PSJHLDFN,"UR",RXON,PSREASON) Q

 I STATUS="H" S DA(1)=PSJHLDFN,DA=+RXON,DIE=$S(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,")

 D NOW^%DTC

 S DR=$S(RXON["V":"100////A;120////@;149////@",1:"28////A;56////@;57////@;58////@;59////@;59.1////@;60////1;62////"_%)

 I RXON["A"!(RXON["U") S PSGAL("C")=8000 D ^PSGAL5

 S:RXON["V" PSIVACT=1,PSIVALT=2,PSIVREA="U",ON55=RXON

 D ^DIE

 I RXON["V" N DFN S DFN=PSJHLDFN D LOG^PSIVORAL

 D EN1^PSJHL2(PSJHLDFN,"OR",RXON)

 D NOW^%DTC I "A"[STATUS I STPDT<% D EXPIR Q

 D AUE(PSJHLDFN,RXON)

 Q

EXPIR ;Change status of order to expired and send notice to OE/RR

 N DA,DIE,DR,PSGPO,PSIVACT

 S STATUS="E",(PSGPO,PSIVACT)=1,DA=+RXON,DA(1)=PSJHLDFN,DIE=$S(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,"),DR=$S(RXON["V":"100////E",1:"28////E") D ^DIE

 S PSJHLMTN="ORM" D EN1^PSJHL2(PSJHLDFN,"SC",RXON) S PSJHLMTN="ORR"

 ;D AUE(PSJHLDFN,RXON)

 Q

AUE(PSJHLDFN,ON)        ; Set "AUE" xref for 55.06 if hold/unhold

 I ON["A"!(ON["U") S ^PS(55,"AUE",PSJHLDFN,+ON)=""

 Q

 ;

A S PSREASON="Active" Q

D S PSREASON="Discontinued" Q

I S PSREASON="Incomplete" Q

N S PSREASON="Non-verified" Q

U S PSREASON="Unreleased" Q

P S PSREASON="Pending" Q

DE S PSREASON="Discontinued (edit)" Q

E S PSREASON="Expired" Q

H S PSREASON="Hold" Q

R S PSREASON="Renewed" Q

RE S PSREASON="Reinstated" Q

DR S PSREASON="Discontinued (renewal)" Q

O S PSREASON="On call" Q

PSJHL6    ;BIR/LDT-ACTIONS ON HL7 MESSAGES FROM OE/RR (CONT) ;02 Mar 99 / 9:26 AM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**1,11,27,34,40,42,51,59,88,98**;16 DEC 97

 +2       ;

 +3       ; Reference to EN^ORERR is supported by DBIA# 2187.

 +4       ; Reference to ^PS(55 is supported by DBIA# 2191.

 +5       ;

CANCEL    ;Cancel or Discontinue orders thru OE/RR

 +1        NEW DA,DR,DIE,STATUS,STPDT,NODE,NODE2,PSREASON,PSIVACT,PSIVALT,ON55,PSIVREA,PSIVALCK,P

 +2        SET NODE=$GET(@(RXORDER_"0)"))

           SET NODE2=$GET(@(RXORDER_"2)"))

 +3        IF 'NODE

               SET PSREASON="Invalid Pharmacy order number"

               Begin DoDot:1

 +4                SET X="ORERR"

                   XECUTE ^%ZOSF("TEST")

                  IF $TEST

                       DO EN^ORERR(PSREASON_"/DC Msg",.PSJMSG)

 +5                DO EN1^PSJHLERR(PSJHLDFN,$SELECT(PSOC="CA":"UC",1:"UD"),$PIECE(ORDER,U),PSREASON)

               End DoDot:1

               QUIT 

 +6        IF RXON["P"

               IF PSJHLDFN'=$PIECE(NODE,U,15)

                   SET ORDCON="Patient does not match/Discontinue Msg"

                   Begin DoDot:1

 +7                    SET X="ORERR"

                       XECUTE ^%ZOSF("TEST")

                      IF $TEST

                           DO EN^ORERR(ORDCON,.PSJMSG)

 +8                    DO EN1^PSJHLERR(PSJHLDFN,$SELECT(PSOC="CA":"UC",1:"UD"),$PIECE(ORDER,U),ORDCON)

                   End DoDot:1

                   QUIT 

 +9        SET $PIECE(@(RXORDER_"0)"),"^",21)=$PIECE(ORDER,"^",1)

 +10       SET STATUS=$SELECT(RXON["V":$PIECE(NODE,"^",17),1:$PIECE(NODE,"^",9))

 +11       SET STPDT=$SELECT(RXON["V":$PIECE(NODE,"^",3),1:$PIECE(NODE2,"^",4))

 +12       IF "AHNOPR"'[STATUS

               DO @STATUS

               SET PSREASON=PSREASON_" orders may not be "_$SELECT(PSOC="CA":"cancelled",1:"discontinued")

               DO EN1^PSJHL2(PSJHLDFN,$SELECT(PSOC="CA":"UC",1:"UD"),RXON,PSREASON)

               QUIT 

 +13       IF (RXON["A")!(RXON["U")!(RXON["V")

               SET DA(1)=PSJHLDFN

               SET DA=+RXON

 +14       DO NOW^%DTC

 +15       SET DIE=$SELECT(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",(RXON["N")!(RXON["P"):"^PS(53.1,",1:"^PS(55,"_PSJHLDFN_",5,")

           SET DA=+RXON

 +16       SET DR=$SELECT(RXON["V":"100////D;116////^S X=STPDT;.03////",(RXON["N")!(RXON["P"):"28////D;25////",1:"25////^S X=STPDT;28////D;34////")_$SELECT($GET(ORDCON)="A"&($GET(PSJASTP)'=""):$GET(PSJASTP),1:%)

 +17       IF RXON["A"!(RXON["U")

               SET PSGAL("C")=$SELECT($GET(ORDCON)="A":1040,1:4000)

               DO ^PSGAL5

 +18       IF RXON["V"

               SET PSIVACT=1

               SET PSIVALT=$SELECT($GET(ORDCON)="A":"",1:2)

               SET PSIVAL=$SELECT($GET(ORDCON)="A":"AUTO DISCONTINUED  (TREATING SPECIALTY TRANSFER)",1:"")

               SET ON55=RXON

               SET PSIVREA="D"

               SET P(3)=STPDT

 +19       IF $GET(ORDCON)="A"

               SET DR=$SELECT(RXON["V":DR_";121////1",RXON["N"!(RXON["P"):DR_";42////1",1:DR_";49////1")

 +20       DO ^DIE

 +21       IF $GET(ORDCON)="A"

               SET $PIECE(^PS(55,PSJHLDFN,5.1),"^")=""

 +22       IF RXON["V"

               NEW DFN

               SET DFN=PSJHLDFN

               DO LOG^PSIVORAL

 +23       DO EN1^PSJHL2(PSJHLDFN,$SELECT(PSOC="CA":"CR",1:"DR"),RXON)

 +24       DO NOW^%DTC

           IF "ANR"[STATUS

               IF STPDT<%

                   DO EXPIR

                   QUIT 

 +25       DO AUE(PSJHLDFN,RXON)

 +26       QUIT 

 +27      ;

HOLD      ;Place orders on hold thru OE/RR and check for expired orders

 +1        NEW DA,DR,DIE,STATUS,STPDT,NODE,NODE2,PSREASON,PSIVACT,PSIVALT,PSIVREA,ON55

 +2        SET NODE=$GET(@(RXORDER_"0)"))

           SET NODE2=$GET(@(RXORDER_"2)"))

 +3        IF 'NODE

               SET PSREASON="Invalid Pharmacy order number"

               Begin DoDot:1

 +4                SET X="ORERR"

                   XECUTE ^%ZOSF("TEST")

                  IF $TEST

                       DO EN^ORERR(PSREASON_"/Hold Msg",.PSJMSG)

 +5                DO EN1^PSJHLERR(PSJHLDFN,"UH",$PIECE(ORDER,U),PSREASON)

               End DoDot:1

               QUIT 

 +6        SET $PIECE(@(RXORDER_"0)"),"^",21)=$PIECE(ORDER,"^",1)

 +7        SET STATUS=$SELECT(RXON["V":$PIECE(NODE,"^",17),1:$PIECE(NODE,"^",9))

 +8        SET STPDT=$SELECT(RXON["V":$PIECE(NODE,"^",3),1:$PIECE(NODE2,"^",4))

 +9        DO NOW^%DTC

           IF "ANR"[STATUS

               IF STPDT<%

                   DO EXPIR

 +10       IF STATUS'="A"

               DO @STATUS

               SET PSREASON=PSREASON_" orders may not be placed on hold"

               DO EN1^PSJHL2(PSJHLDFN,"UH",RXON,PSREASON)

               QUIT 

 +11       IF STATUS="A"

               SET DA(1)=PSJHLDFN

               SET DA=+RXON

               SET DIE=$SELECT(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,")

               SET DR=$SELECT(RXON["V":"100////H;120////1;149////1",1:"28////H;56////1;59////A;59.1////1;60////@;61////@;62////@;58////"_%)

 +12       IF RXON["A"!(RXON["U")

               SET PSGAL("C")=8500

               DO ^PSGAL5

 +13       IF RXON["V"

               SET PSIVACT=1

               SET PSIVALT=2

               SET PSIVREA="H"

               SET ON55=RXON

 +14       DO ^DIE

 +15       IF RXON["V"

               NEW DFN

               SET DFN=PSJHLDFN

               DO LOG^PSIVORAL

 +16       DO EN1^PSJHL2(PSJHLDFN,"HR",RXON)

 +17       DO NOW^%DTC

           IF "ANR"[STATUS

               IF STPDT<%

                   DO EXPIR

                   QUIT 

 +18       DO AUE(PSJHLDFN,RXON)

 +19       QUIT 

 +20      ;

UNHOLD    ;Change status of orders palced on hold thru OE/RR & check for expired orders

 +1        NEW DA,DR,DIE,STATUS,STPDT,NODE,NODE2,NODE4,HFLAG,PSREASON,PSIVACT,PSIVALT,PSIVREA,ON55

 +2        SET NODE=$GET(@(RXORDER_"0)"))

           SET NODE2=$GET(@(RXORDER_"2)"))

           SET NODE4=$GET(@(RXORDER_"4)"))

 +3        IF 'NODE

               SET PSREASON="Invalid Pharmacy order number"

               Begin DoDot:1

 +4                SET X="ORERR"

                   XECUTE ^%ZOSF("TEST")

                  IF $TEST

                       DO EN^ORERR(PSREASON_"/Unhold Msg",.PSJMSG)

 +5                DO EN1^PSJHLERR(PSJHLDFN,"UR",$PIECE(ORDER,U),PSREASON)

               End DoDot:1

               QUIT 

 +6        SET $PIECE(@(RXORDER_"0)"),"^",21)=$PIECE(ORDER,"^",1)

 +7        SET STATUS=$SELECT(RXON["V":$PIECE(NODE,"^",17),1:$PIECE(NODE,"^",9))

 +8        SET STPDT=$SELECT(RXON["V":$PIECE(NODE,"^",3),1:$PIECE(NODE2,"^",4))

 +9        SET HFLAG=$SELECT(RXON["V":$PIECE(NODE,"^",10),1:$PIECE(NODE4,"^",26))

 +10       IF 'HFLAG

               SET PSREASON="Orders placed on hold by Pharmacy may not be removed from hold through CPRS."

               DO EN1^PSJHL2(PSJHLDFN,"UR",RXON,PSREASON)

               QUIT 

 +11       IF "H"'[STATUS

               DO @STATUS

               SET PSREASON=PSREASON_" orders may not be taken off hold"

               DO EN1^PSJHL2(PSJHLDFN,"UR",RXON,PSREASON)

               QUIT 

 +12       IF STATUS="H"

               SET DA(1)=PSJHLDFN

               SET DA=+RXON

               SET DIE=$SELECT(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,")

 +13       DO NOW^%DTC

 +14       SET DR=$SELECT(RXON["V":"100////A;120////@;149////@",1:"28////A;56////@;57////@;58////@;59////@;59.1////@;60////1;62////"_%)

 +15       IF RXON["A"!(RXON["U")

               SET PSGAL("C")=8000

               DO ^PSGAL5

 +16       IF RXON["V"

               SET PSIVACT=1

               SET PSIVALT=2

               SET PSIVREA="U"

               SET ON55=RXON

 +17       DO ^DIE

 +18       IF RXON["V"

               NEW DFN

               SET DFN=PSJHLDFN

               DO LOG^PSIVORAL

 +19       DO EN1^PSJHL2(PSJHLDFN,"OR",RXON)

 +20       DO NOW^%DTC

           IF "A"[STATUS

               IF STPDT<%

                   DO EXPIR

                   QUIT 

 +21       DO AUE(PSJHLDFN,RXON)

 +22       QUIT 

EXPIR     ;Change status of order to expired and send notice to OE/RR

 +1        NEW DA,DIE,DR,PSGPO,PSIVACT

 +2        SET STATUS="E"

           SET (PSGPO,PSIVACT)=1

           SET DA=+RXON

           SET DA(1)=PSJHLDFN

           SET DIE=$SELECT(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,")

           SET DR=$SELECT(RXON["V":"100////E",1:"28////E")

           DO ^DIE

 +3        SET PSJHLMTN="ORM"

           DO EN1^PSJHL2(PSJHLDFN,"SC",RXON)

           SET PSJHLMTN="ORR"

 +4       ;D AUE(PSJHLDFN,RXON)

 +5        QUIT 

AUE(PSJHLDFN,ON) ; Set "AUE" xref for 55.06 if hold/unhold

 +1        IF ON["A"!(ON["U")

               SET ^PS(55,"AUE",PSJHLDFN,+ON)=""

 +2        QUIT 

 +3       ;

A          SET PSREASON="Active"

           QUIT 

D          SET PSREASON="Discontinued"

           QUIT 

I          SET PSREASON="Incomplete"

           QUIT 

N          SET PSREASON="Non-verified"

           QUIT 

U          SET PSREASON="Unreleased"

           QUIT 

P          SET PSREASON="Pending"

           QUIT 

DE         SET PSREASON="Discontinued (edit)"

           QUIT 

E          SET PSREASON="Expired"

           QUIT 

H          SET PSREASON="Hold"

           QUIT 

R          SET PSREASON="Renewed"

           QUIT 

RE         SET PSREASON="Reinstated"

           QUIT 

DR         SET PSREASON="Discontinued (renewal)"

           QUIT 

O          SET PSREASON="On call"

           QUIT