Routine: ORKCHK6

ORKCHK6 ; SLC/CLA - Support routine called by ORKCHK to do SESSION mode order checks ;03/21/18  06:21

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,87,94,123,162,190,249,280,272,346,345,269,469,481**;Dec 17, 1997;Build 3

EN(ORKS,ORKDFN,ORKA,ORENT,ORKTMODE) ;perform order checking for entire ordering session

 Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE",1,"I")="D"

 N OI,ORKDG,HL7,ODT,ORNUM,HL7NPTR,HL7NTXT,HL7NCOD,HL7LPTR,HL7LTXT,HL7LCOD

 N ORKMSG,ORKDGI,ORKTXT,ORKPDATA,ORIFN

 S OI=$P(ORKA,"|"),ORKDG=$P(ORKA,"|",2),HL7=$P(ORKA,"|",3)

 S ODT=$P(ORKA,"|",4),ORNUM=$P(ORKA,"|",5),ORKPDATA=$P(ORKA,"|",6)

 S HL7NPTR=$P(HL7,U),HL7NTXT=$P(HL7,U,2),HL7NCOD=$P(HL7,U,3)

 S HL7LPTR=$P(HL7,U,4),HL7LTXT=$P(HL7,U,5),HL7LCOD=$P(HL7,U,6)

 S ORIFN=ORNUM

 S:ORKDG="PSJ" ORKDG="PSI"

 I $E(ORKDG,1,2)="PS" D PHARM

 I $E(ORKDG,1,2)'="PS" D MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")

PHARM ;process pharmacy order checks:

 N ORPSPKG,ORPSA,ORRXDONE

 N ORCRITN,ORCRITF,ORCRITD,ORSIGN,ORSIGF,ORSIGD,ORDUPN,ORDUPF,ORDUPD,ORDUPC,ORDUPCF,ORDUPCD,ORALLRN,ORALLRF,ORALLRD,ORDUPCN

 D PARAMS("ALLERGY-DRUG INTERACTION",.ORALLRN,.ORALLRF,.ORALLRD)

 D PARAMS("CRITICAL DRUG INTERACTION",.ORCRITN,.ORCRITF,.ORCRITD)

 D PARAMS("SIGNIFICANT DRUG INTERACTION",.ORSIGN,.ORSIGF,.ORSIGD)

 D PARAMS("DUPLICATE DRUG ORDER",.ORDUPN,.ORDUPF,.ORDUPD)

 D PARAMS("DUPLICATE DRUG THERAPY",.ORDUPCN,.ORDUPCF,.ORDUPCD)

 S ORRXDONE=0 ;flag to set if RXOCS gets called

 ;dispense drug selected:

 I $L($G(HL7LPTR)),($G(HL7LCOD)="99PSD") D

 .D RXOCS

 .S:$P(ORKA,"|",7)'="" $P(ORKA,"|",7)=""

 .S ORRXDONE=1

 .D MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")

 ;dispense drug NOT selected, split OI into dispense drugs:

 I '$L($G(HL7LPTR)) D

 .S ORPSPKG=$E(ORKDG,3)

 .I "IOH"[ORPSPKG D

 ..S ORPSA=$$OI2DD^ORKPS(OI,ORPSPKG,1)

 ..I +ORPSA D

 ...S HL7LTXT=$P($G(^ORD(101.43,OI,0)),U)

 ...S HL7NPTR=$P(ORPSA,";",2)

 ...S HL7LPTR=+ORPSA

 ...S HL7LCOD="99PSD",HL7NCOD="99NDF"

 ...S $P(HL7,U)=HL7NPTR,$P(HL7,U,3)=HL7NCOD

 ...S $P(HL7,U,4)=HL7LPTR,$P(HL7,U,5)=HL7LTXT,$P(HL7,U,6)=HL7LCOD

 ...S $P(ORKA,"|",3)=HL7  ;set these for MLM OCX call

 ..D RXOCS

 ..S:$P(ORKA,"|",7)'="" $P(ORKA,"|",7)=""

 ..S ORRXDONE=1

 ..Q:HL7LTXT=""

 ..D MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")

 I ORRXDONE=0 D

 .N ORKSMSG,OROITXT

 .S OROITXT=$P($G(^ORD(101.43,OI,0)),U)

 .I $L(OROITXT)>0 S OROITXT=" for "_$$TRIM^XLFSTR(OROITXT)

 .S ORKMSG="Enhanced order checks cannot be done"_OROITXT_". Please perform a manual check for Drug-Interactions, Duplicate Therapy"

 .I $$DS^PSSDSAPI S ORKMSG=ORKMSG_" and Dosing"

 .S ORKS("ORK",2_$E(ORKMSG,1,225))=ORNUM_U_25_U_3_U_ORKMSG

RXOCS ;drug-drug interaction, duplicate drug order, duplicate drug class

 Q:ORCRITF_ORSIGF_ORDUPF_ORDUPCF_ORALLRF'["E"  ;quit if none are "E"nabled

 N ORKRX,ORPSNUM,ORY,CHK,XX

 ;I $L($G(HL7LPTR)),($G(HL7LCOD)="99PSD") D

 I 1 D

 .D CHKSESS^ORKPS(.ORKRX,ORKDFN,HL7LPTR_U_HL7LTXT,OI,ORKPDATA,ORKDG,+$P($G(ORPSA),";",4),$P(ORKA,"|",7))

 .S CHK=0,XX="" F  S CHK=$O(ORKRX(CHK)) Q:'CHK  D

 ..S XX=ORKRX(CHK)

..;

 ..;get errors/exceptions/checks not done

 ..I $P(XX,U)="ERR" S ORKS("ORK",2_$E($P(XX,U,2),1,225)_","_$G(ORNUM))=ORNUM_U_25_U_3_U_$P(XX,U,2)

..;

 ..;critical drug interaction:

 ..I $P(XX,U)="DI",$P(XX,U,2)="CRITICAL" D

 ...Q:ORCRITF="D"

 ...S ORPSNUM=$P(XX,U,3)

 ...S ORKTXT=$P(XX,U,2)_" drug-drug interaction: "_$P(XX,U,5)

 ...S ORKS("ORK",ORCRITD_","_$G(ORNUM)_","_ORPSNUM_","_$E(ORKTXT,1,225))=ORNUM_U_ORCRITN_U_ORCRITD_U_ORKTXT

..;

 ..;significant drug interaction:

 ..I $P(XX,U)="DI",$P(XX,U,2)="SIGNIFICANT" D

 ...Q:ORSIGF="D"

 ...S ORPSNUM=$P(XX,U,3)

 ...S ORKTXT=$P(XX,U,2)_" drug-drug interaction: "_$P(XX,U,5)

 ...S ORKS("ORK",ORSIGD_","_$G(ORNUM)_","_ORPSNUM_","_$E(ORKTXT,1,225))=ORNUM_U_ORSIGN_U_ORSIGD_U_ORKTXT

..;

 ..;duplicate drug:

 ..I $P(XX,U)="DD" D

 ...Q:ORDUPF="D"

 ...S ORPSNUM=$P(XX,U,4)  ;get the associated order number

 ...S ORKTXT=$P(XX,U,3)

 ...I $L(ORPSNUM),$G(^OR(100,+ORPSNUM,0)) D

 ....D TEXT^ORQ12(.ORY,ORPSNUM,"")

 ....S ORKTXT=ORKTXT_$S($D(ORY(2))=1:" "_$$TRIM^XLFSTR(ORY(2)),1:"")_" ["_$P($G(^ORD(100.01,+$P(^OR(100,+ORPSNUM,3),U,3),0)),U,1)_"]"

 ...S ORKMSG="Duplicate drug order: "_ORKTXT

 ...S ORKS("ORK",ORDUPD_","_$G(ORNUM)_","_ORPSNUM_",Duplicate drug order: "_$E($P(XX,U,3),1,200))=ORNUM_U_ORDUPN_U_ORDUPD_U_ORKMSG_U_$G(ORPSNUM)

..;

 ..;duplicate class: NOW DRUG THERAPY

 ..I $P(XX,U)="DC" D

 ...Q:ORDUPCF="D"

 ...S ORPSNUM=$P(XX,U,2)  ;get the associated order number

 ...S ORKMSG=$P(XX,U,4)

 ...N ORKCNT S ORKCNT=1 F  Q:'$D(ORKS("ORK",ORDUPCD_","_$G(ORNUM)_","_ORPSNUM_","_ORKCNT))  S ORKCNT=ORKCNT+1

 ...S ORKS("ORK",ORDUPCD_","_$G(ORNUM)_","_ORPSNUM_","_ORKCNT)=ORNUM_U_ORDUPCN_U_ORDUPCD_U_ORKMSG

 D RXOCS^ORKCHK5

PARAMS(ORKNAME,ORKNUM,ORKFLAG,ORKDNGR) ; get parameter values for an order chk

 S ORKNUM=0,ORKNUM=$O(^ORD(100.8,"B",ORKNAME,ORKNUM))

 S ORKFLAG=$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",ORKNUM,"I")

 S ORKDNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",ORKNUM,"I")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORKCHK6   5116     printed  Mar 13, 2025@21:36:01                                                                                                                                                                                                     Page 2

ORKCHK6   ; SLC/CLA - Support routine called by ORKCHK to do SESSION mode order checks ;03/21/18  06:21

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,87,94,123,162,190,249,280,272,346,345,269,469,481**;Dec 17, 1997;Build 3

 +2        QUIT

 +3       ;

EN(ORKS,ORKDFN,ORKA,ORENT,ORKTMODE) ;perform order checking for entire ordering session

 +1        if $$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE",1,"I")="D"

               QUIT

 +2       ;

 +3        NEW OI,ORKDG,HL7,ODT,ORNUM,HL7NPTR,HL7NTXT,HL7NCOD,HL7LPTR,HL7LTXT,HL7LCOD

 +4        NEW ORKMSG,ORKDGI,ORKTXT,ORKPDATA,ORIFN

 +5       ;

 +6        SET OI=$PIECE(ORKA,"|")

           SET ORKDG=$PIECE(ORKA,"|",2)

           SET HL7=$PIECE(ORKA,"|",3)

 +7        SET ODT=$PIECE(ORKA,"|",4)

           SET ORNUM=$PIECE(ORKA,"|",5)

           SET ORKPDATA=$PIECE(ORKA,"|",6)

 +8        SET HL7NPTR=$PIECE(HL7,U)

           SET HL7NTXT=$PIECE(HL7,U,2)

           SET HL7NCOD=$PIECE(HL7,U,3)

 +9        SET HL7LPTR=$PIECE(HL7,U,4)

           SET HL7LTXT=$PIECE(HL7,U,5)

           SET HL7LCOD=$PIECE(HL7,U,6)

 +10       SET ORIFN=ORNUM

 +11      ;

 +12       if ORKDG="PSJ"

               SET ORKDG="PSI"

 +13       IF $EXTRACT(ORKDG,1,2)="PS"

               DO PHARM

 +14       IF $EXTRACT(ORKDG,1,2)'="PS"

               DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")

 +15       QUIT

 +16      ;

PHARM     ;process pharmacy order checks:

 +1        NEW ORPSPKG,ORPSA,ORRXDONE

 +2        NEW ORCRITN,ORCRITF,ORCRITD,ORSIGN,ORSIGF,ORSIGD,ORDUPN,ORDUPF,ORDUPD,ORDUPC,ORDUPCF,ORDUPCD,ORALLRN,ORALLRF,ORALLRD,ORDUPCN

 +3       ;

 +4        DO PARAMS("ALLERGY-DRUG INTERACTION",.ORALLRN,.ORALLRF,.ORALLRD)

 +5        DO PARAMS("CRITICAL DRUG INTERACTION",.ORCRITN,.ORCRITF,.ORCRITD)

 +6        DO PARAMS("SIGNIFICANT DRUG INTERACTION",.ORSIGN,.ORSIGF,.ORSIGD)

 +7        DO PARAMS("DUPLICATE DRUG ORDER",.ORDUPN,.ORDUPF,.ORDUPD)

 +8        DO PARAMS("DUPLICATE DRUG THERAPY",.ORDUPCN,.ORDUPCF,.ORDUPCD)

 +9       ;

 +10      ;flag to set if RXOCS gets called

           SET ORRXDONE=0

 +11      ;dispense drug selected:

 +12       IF $LENGTH($GET(HL7LPTR))

               IF ($GET(HL7LCOD)="99PSD")

                   Begin DoDot:1

 +13                   DO RXOCS

 +14                   if $PIECE(ORKA,"|",7)'=""

                           SET $PIECE(ORKA,"|",7)=""

 +15                   SET ORRXDONE=1

 +16                   DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")

                   End DoDot:1

 +17      ;

 +18      ;dispense drug NOT selected, split OI into dispense drugs:

 +19       IF '$LENGTH($GET(HL7LPTR))

               Begin DoDot:1

 +20               SET ORPSPKG=$EXTRACT(ORKDG,3)

 +21               IF "IOH"[ORPSPKG

                       Begin DoDot:2

 +22                       SET ORPSA=$$OI2DD^ORKPS(OI,ORPSPKG,1)

 +23                       IF +ORPSA

                               Begin DoDot:3

 +24                               SET HL7LTXT=$PIECE($GET(^ORD(101.43,OI,0)),U)

 +25                               SET HL7NPTR=$PIECE(ORPSA,";",2)

 +26                               SET HL7LPTR=+ORPSA

 +27                               SET HL7LCOD="99PSD"

                                   SET HL7NCOD="99NDF"

 +28                               SET $PIECE(HL7,U)=HL7NPTR

                                   SET $PIECE(HL7,U,3)=HL7NCOD

 +29                               SET $PIECE(HL7,U,4)=HL7LPTR

                                   SET $PIECE(HL7,U,5)=HL7LTXT

                                   SET $PIECE(HL7,U,6)=HL7LCOD

 +30      ;set these for MLM OCX call

                                   SET $PIECE(ORKA,"|",3)=HL7

                               End DoDot:3

 +31                       DO RXOCS

 +32                       if $PIECE(ORKA,"|",7)'=""

                               SET $PIECE(ORKA,"|",7)=""

 +33                       SET ORRXDONE=1

 +34                       if HL7LTXT=""

                               QUIT

 +35                       DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")

                       End DoDot:2

               End DoDot:1

 +36       IF ORRXDONE=0

               Begin DoDot:1

 +37               NEW ORKSMSG,OROITXT

 +38               SET OROITXT=$PIECE($GET(^ORD(101.43,OI,0)),U)

 +39               IF $LENGTH(OROITXT)>0

                       SET OROITXT=" for "_$$TRIM^XLFSTR(OROITXT)

 +40               SET ORKMSG="Enhanced order checks cannot be done"_OROITXT_". Please perform a manual check for Drug-Interactions, Duplicate Therapy"

 +41               IF $$DS^PSSDSAPI

                       SET ORKMSG=ORKMSG_" and Dosing"

 +42               SET ORKS("ORK",2_$EXTRACT(ORKMSG,1,225))=ORNUM_U_25_U_3_U_ORKMSG

               End DoDot:1

 +43       QUIT

 +44      ;

RXOCS     ;drug-drug interaction, duplicate drug order, duplicate drug class

 +1       ;quit if none are "E"nabled

           if ORCRITF_ORSIGF_ORDUPF_ORDUPCF_ORALLRF'["E"

               QUIT

 +2        NEW ORKRX,ORPSNUM,ORY,CHK,XX

 +3       ;I $L($G(HL7LPTR)),($G(HL7LCOD)="99PSD") D

 +4        IF 1

               Begin DoDot:1

 +5                DO CHKSESS^ORKPS(.ORKRX,ORKDFN,HL7LPTR_U_HL7LTXT,OI,ORKPDATA,ORKDG,+$PIECE($GET(ORPSA),";",4),$PIECE(ORKA,"|",7))

 +6                SET CHK=0

                   SET XX=""

FOR

                       SET CHK=$ORDER(ORKRX(CHK))

                       if 'CHK

                           QUIT

                       Begin DoDot:2

 +7                        SET XX=ORKRX(CHK)

 +8       ;

 +9       ;get errors/exceptions/checks not done

 +10                       IF $PIECE(XX,U)="ERR"

                               SET ORKS("ORK",2_$EXTRACT($PIECE(XX,U,2),1,225)_","_$GET(ORNUM))=ORNUM_U_25_U_3_U_$PIECE(XX,U,2)

 +11      ;

 +12      ;critical drug interaction:

 +13                       IF $PIECE(XX,U)="DI"

                               IF $PIECE(XX,U,2)="CRITICAL"

                                   Begin DoDot:3

 +14                                   if ORCRITF="D"

                                           QUIT

 +15                                   SET ORPSNUM=$PIECE(XX,U,3)

 +16                                   SET ORKTXT=$PIECE(XX,U,2)_" drug-drug interaction: "_$PIECE(XX,U,5)

 +17                                   SET ORKS("ORK",ORCRITD_","_$GET(ORNUM)_","_ORPSNUM_","_$EXTRACT(ORKTXT,1,225))=ORNUM_U_ORCRITN_U_ORCRITD_U_ORKTXT

                                   End DoDot:3

 +18      ;

 +19      ;significant drug interaction:

 +20                       IF $PIECE(XX,U)="DI"

                               IF $PIECE(XX,U,2)="SIGNIFICANT"

                                   Begin DoDot:3

 +21                                   if ORSIGF="D"

                                           QUIT

 +22                                   SET ORPSNUM=$PIECE(XX,U,3)

 +23                                   SET ORKTXT=$PIECE(XX,U,2)_" drug-drug interaction: "_$PIECE(XX,U,5)

 +24                                   SET ORKS("ORK",ORSIGD_","_$GET(ORNUM)_","_ORPSNUM_","_$EXTRACT(ORKTXT,1,225))=ORNUM_U_ORSIGN_U_ORSIGD_U_ORKTXT

                                   End DoDot:3

 +25      ;

 +26      ;duplicate drug:

 +27                       IF $PIECE(XX,U)="DD"

                               Begin DoDot:3

 +28                               if ORDUPF="D"

                                       QUIT

 +29      ;get the associated order number

                                   SET ORPSNUM=$PIECE(XX,U,4)

 +30                               SET ORKTXT=$PIECE(XX,U,3)

 +31                               IF $LENGTH(ORPSNUM)

                                       IF $GET(^OR(100,+ORPSNUM,0))

                                           Begin DoDot:4

 +32                                           DO TEXT^ORQ12(.ORY,ORPSNUM,"")

 +33                                           SET ORKTXT=ORKTXT_$SELECT($DATA(ORY(2))=1:" "_$$TRIM^XLFSTR(ORY(2)),1:"")_" ["_$PIECE($GET(^ORD(100.01,+$PIECE(^OR(100,+ORPSNUM,3),U,3),0)),U,1)_"]"

                                           End DoDot:4

 +34                               SET ORKMSG="Duplicate drug order: "_ORKTXT

 +35                               SET ORKS("ORK",ORDUPD_","_$GET(ORNUM)_","_ORPSNUM_",Duplicate drug order: "_$EXTRACT($PIECE(XX,U,3),1,200))=ORNUM_U_ORDUPN_U_ORDUPD_U_ORKMSG_U_$GET(ORPSNUM)

                               End DoDot:3

 +36      ;

 +37      ;duplicate class: NOW DRUG THERAPY

 +38                       IF $PIECE(XX,U)="DC"

                               Begin DoDot:3

 +39                               if ORDUPCF="D"

                                       QUIT

 +40      ;get the associated order number

                                   SET ORPSNUM=$PIECE(XX,U,2)

 +41                               SET ORKMSG=$PIECE(XX,U,4)

 +42                               NEW ORKCNT

                                   SET ORKCNT=1

FOR

                                       if '$DATA(ORKS("ORK",ORDUPCD_","_$GET(ORNUM)_","_ORPSNUM_","_ORKCNT))

                                           QUIT

                                       SET ORKCNT=ORKCNT+1

 +43                               SET ORKS("ORK",ORDUPCD_","_$GET(ORNUM)_","_ORPSNUM_","_ORKCNT)=ORNUM_U_ORDUPCN_U_ORDUPCD_U_ORKMSG

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +44       DO RXOCS^ORKCHK5

 +45       QUIT

 +46      ;

PARAMS(ORKNAME,ORKNUM,ORKFLAG,ORKDNGR) ; get parameter values for an order chk

 +1        SET ORKNUM=0

           SET ORKNUM=$ORDER(^ORD(100.8,"B",ORKNAME,ORKNUM))

 +2        SET ORKFLAG=$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",ORKNUM,"I")

 +3        SET ORKDNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",ORKNUM,"I")

 +4        QUIT

ORKCHK6.m