Routine: ORY350A

ORY350A ;ISP/JLC,RFR - POST-INSTALL FOR PATCH OR*3.0*350 ;04/27/2015  08:48

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**350**;Dec 17, 1997;Build 77

SUPPLY ;correct entries in 101.43 and build list of supply

 ;entries in 101.44

 N S1,S2,S3,PSOI,PSVAC,FDA,ORFIEN

 K ^TMP($J,"ORY350A"),^TMP($J,"ORY350A1")

 S S1="" F  S S1=$O(^ORD(101.43,"S.SPLY",S1)) Q:S1=""  D

 . S S2=0

 . F  S S2=$O(^ORD(101.43,"S.SPLY",S1,S2)) Q:'S2  D

 .. S ORFIEN=S2_",",PSOI=+$P(^ORD(101.43,S2,0),"^",2) D DRGIEN^PSS50P7(PSOI,"","ORY350A")

 .. I ^TMP($J,"ORY350A",0)'>0 Q

 .. S S3=0

 .. F  S S3=$O(^TMP($J,"ORY350A",S3)) Q:'S3  D

 ... D ZERO^PSS50(S3,,,,,"ORY350A1")

 ... I ^TMP($J,"ORY350A1",0)'>0 Q

 ... S PSVAC=$G(^TMP($J,"ORY350A1",S3,2)),FDA(101.43,ORFIEN,50.5)=0

 ... I PSVAC?1"XA".E!(PSVAC?1"XX".E)!(PSVAC="DX900"&($G(^TMP($J,"ORY350A1",S3,3))["S")) S FDA(101.43,ORFIEN,50.5)=1

 ... D FILE^DIE("","FDA")

 ;build supply item list for order dialog

 D FVBLDQ^ORWUL("SPLY",1)

NOTIFI() ;CREATE NEW NOTIFICATIONS

 N ORFDA,ORIEN,ORERROR,ENT,PAR,INST,ORERROR,EXIT,ORVALUE

 D MES^XPDUTL("    LAPSED UNSIGNED ORDER")

 S ENT="PKG."_"ORDER ENTRY/RESULTS REPORTING",INST="LAPSED UNSIGNED ORDER"

 S ORVALUE("ORB ARCHIVE PERIOD")=30

 S ORVALUE("ORB DELETE MECHANISM")="Individual Recipient"

 S ORVALUE("ORB FORWARD BACKUP REVIEWER")=0

 S ORVALUE("ORB FORWARD SUPERVISOR")=0

 S ORVALUE("ORB FORWARD SURROGATES")=0

 S ORVALUE("ORB PROCESSING FLAG")="Disabled"

 S ORVALUE("ORB PROVIDER RECIPIENTS")="OAPT"

 S ORVALUE("ORB URGENCY")="High"

 S PAR="" F  S PAR=$O(ORVALUE(PAR)) Q:$G(PAR)=""!($G(EXIT))  D

 .D EN^XPAR(ENT,PAR,INST,ORVALUE(PAR),.ORERROR)  ;ICR #2336

 .I +ORERROR D

 ..S ORMSG(1)=" ",EXIT=1

 ..S ORMSG(2)="ERROR: Unable to configure the new Lapsed Unsigned Order(s) notification"

 ..S ORMSG(3)="Kernel Parameter Tools Error #"_+ORERROR_": "_$P(ORERROR,U,2)

 ..D BMES^XPDUTL(.ORMSG)

 Q:$G(EXIT) 0

Q 1

SQOCONV() ;CONVERT EXISTING OUTPATIENT MEDICATION QUICK ORDERS INTO SUPPLY QUICK ORDERS

 N DG,DLG,ORTEXT

 S DG("OUT")=$O(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0))

 I +DG("OUT")=0 D  Q 0

 .S ORTEXT(1)="Unable to find the OUTPATIENT MEDICATIONS display group in the DISPLAY GROUP"

 .S ORTEXT(2)="file (#100.98). Please log a Remedy ticket for assistance."

 .D BMES^XPDUTL(.ORTEXT)

 S DG("SUPPLY")=$O(^ORD(100.98,"B","SUPPLIES/DEVICES",0))

 I +DG("SUPPLY")=0 D  Q 0

 .S ORTEXT(1)="Unable to find the SUPPLIES/DEVICES display group in the DISPLAY GROUP file"

 .S ORTEXT(2)="(#100.98). Please log a Remedy ticket for assistance."

 .D BMES^XPDUTL(.ORTEXT)

 S DLG("ORDERABLE ITEM")=+$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))

 I DLG("ORDERABLE ITEM")=0 D  Q 0

 .S ORTEXT(1)="Unable to find the OR GTX ORDERABLE ITEM dialog in the ORDER DIALOG file"

 .S ORTEXT(2)="(#101.41). Please log a Remedy ticket for assistance."

 N IEN,EXIT

 S IEN=0 F  S IEN=$O(^ORD(101.41,IEN)) Q:+$G(IEN)=0!($G(EXIT))  D

 .;SKIP DISABLED QUICK ORDER (FIELD #3 NOT BLANK)

 .Q:$P(^ORD(101.41,IEN,0),U,3)'=""

 .;SKIP NON-QUICK ORDER

 .Q:$P(^ORD(101.41,IEN,0),U,4)'="Q"

 .;SKIP NON-OUTPATIENT MEDICATIONS

 .Q:$P(^ORD(101.41,IEN,0),U,5)'=DG("OUT")

 .;DETERMINE IF THE ORDERABLE ITEM IS A SUPPLY

 .N RIEN,ORPHOI,ORDRGIEN,SET

 .S RIEN=+$O(^ORD(101.41,IEN,6,"D",DLG("ORDERABLE ITEM"),0))

 .Q:RIEN=0

 .S ORPHOI=+$P($G(^ORD(101.41,IEN,6,RIEN,1)),U,1)

 .Q:ORPHOI=0

 .S ORPHOI=$P($G(^ORD(101.43,ORPHOI,0)),U,2)

 .Q:$P(ORPHOI,";",2)'="99PSP"

 .D DRGIEN^PSS50P7(+ORPHOI,,"ORSUPPLY")

 .Q:+^TMP($J,"ORSUPPLY",0)<1

 .S ORDRGIEN=0 F  S ORDRGIEN=$O(^TMP($J,"ORSUPPLY",ORDRGIEN)) Q:'+$G(ORDRGIEN)!($G(EXIT))!($G(SET))  D

 ..D ZERO^PSS50(ORDRGIEN,,,,,"ORDRUG")

 ..Q:+^TMP($J,"ORDRUG",0)<1

 ..I $$ISSUPPLY(ORDRGIEN),'$G(SET) D

 ...;CHANGE THE DISPLAY GROUP

 ...N FDA,ERROR

 ...S FDA(101.41,IEN_",",5)=DG("SUPPLY")

 ...D FILE^DIE("K","FDA","ERROR")

 ...I $D(ERROR) D  Q

 ....D ERROR("Unable to convert quick order IEN #"_IEN,.ERROR)

 ....S EXIT=1

 ...S SET=1

 K ^TMP($J,"ORSUPPLY")

Q 1

ISSUPPLY(ORDRGIEN) ;DETERMINE IF DRUG IS A SUPPLY ITEM

 ;PARAMETERS: ORDRGIEN=>DRUG IEN IN ^TMP($J,"ORDRUG") GLOBAL

 Q:"^XA^XX^"[(U_$E(^TMP($J,"ORDRUG",ORDRGIEN,2),1,2)_U)!(^TMP($J,"ORDRUG",ORDRGIEN,2)="DX900"&($G(^TMP($J,"ORDRUG",ORDRGIEN,3))["S")) 1

Q 0

ERROR(TEXT,ERROR) ;OUTPUT FILEMAN ERROR MESSAGE(S)

 N ORMSG,IDX

 S ORMSG(1)=" "

 S ORMSG(2)="ERROR: "_TEXT_"."

 S ORMSG(3)="VA FileMan Error #"_ERROR("DIERR",1)_":"

 F IDX=1:1:+$O(ERROR("DIERR",1,"TEXT","A"),-1) D

 .S ORMSG(IDX+2)=ERROR("DIERR",1,"TEXT",IDX)

 D BMES^XPDUTL(.ORMSG)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY350A   4560     printed  Mar 13, 2025@21:46:26                                                                                                                                                                                                     Page 2

ORY350A   ;ISP/JLC,RFR - POST-INSTALL FOR PATCH OR*3.0*350 ;04/27/2015  08:48

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**350**;Dec 17, 1997;Build 77

 +2        QUIT

SUPPLY    ;correct entries in 101.43 and build list of supply

 +1       ;entries in 101.44

 +2        NEW S1,S2,S3,PSOI,PSVAC,FDA,ORFIEN

 +3        KILL ^TMP($JOB,"ORY350A"),^TMP($JOB,"ORY350A1")

 +4        SET S1=""

FOR

               SET S1=$ORDER(^ORD(101.43,"S.SPLY",S1))

               if S1=""

                   QUIT

               Begin DoDot:1

 +5                SET S2=0

 +6                FOR

                       SET S2=$ORDER(^ORD(101.43,"S.SPLY",S1,S2))

                       if 'S2

                           QUIT

                       Begin DoDot:2

 +7                        SET ORFIEN=S2_","

                           SET PSOI=+$PIECE(^ORD(101.43,S2,0),"^",2)

                           DO DRGIEN^PSS50P7(PSOI,"","ORY350A")

 +8                        IF ^TMP($JOB,"ORY350A",0)'>0

                               QUIT

 +9                        SET S3=0

 +10                       FOR

                               SET S3=$ORDER(^TMP($JOB,"ORY350A",S3))

                               if 'S3

                                   QUIT

                               Begin DoDot:3

 +11                               DO ZERO^PSS50(S3,,,,,"ORY350A1")

 +12                               IF ^TMP($JOB,"ORY350A1",0)'>0

                                       QUIT

 +13                               SET PSVAC=$GET(^TMP($JOB,"ORY350A1",S3,2))

                                   SET FDA(101.43,ORFIEN,50.5)=0

 +14                               IF PSVAC?1"XA".E!(PSVAC?1"XX".E)!(PSVAC="DX900"&($GET(^TMP($JOB,"ORY350A1",S3,3))["S"))

                                       SET FDA(101.43,ORFIEN,50.5)=1

 +15                               DO FILE^DIE("","FDA")

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +16      ;build supply item list for order dialog

 +17       DO FVBLDQ^ORWUL("SPLY",1)

 +18       QUIT

NOTIFI()  ;CREATE NEW NOTIFICATIONS

 +1        NEW ORFDA,ORIEN,ORERROR,ENT,PAR,INST,ORERROR,EXIT,ORVALUE

 +2        DO MES^XPDUTL("    LAPSED UNSIGNED ORDER")

 +3        SET ENT="PKG."_"ORDER ENTRY/RESULTS REPORTING"

           SET INST="LAPSED UNSIGNED ORDER"

 +4        SET ORVALUE("ORB ARCHIVE PERIOD")=30

 +5        SET ORVALUE("ORB DELETE MECHANISM")="Individual Recipient"

 +6        SET ORVALUE("ORB FORWARD BACKUP REVIEWER")=0

 +7        SET ORVALUE("ORB FORWARD SUPERVISOR")=0

 +8        SET ORVALUE("ORB FORWARD SURROGATES")=0

 +9        SET ORVALUE("ORB PROCESSING FLAG")="Disabled"

 +10       SET ORVALUE("ORB PROVIDER RECIPIENTS")="OAPT"

 +11       SET ORVALUE("ORB URGENCY")="High"

 +12       SET PAR=""

FOR

               SET PAR=$ORDER(ORVALUE(PAR))

               if $GET(PAR)=""!($GET(EXIT))

                   QUIT

               Begin DoDot:1

 +13      ;ICR #2336

                   DO EN^XPAR(ENT,PAR,INST,ORVALUE(PAR),.ORERROR)

 +14               IF +ORERROR

                       Begin DoDot:2

 +15                       SET ORMSG(1)=" "

                           SET EXIT=1

 +16                       SET ORMSG(2)="ERROR: Unable to configure the new Lapsed Unsigned Order(s) notification"

 +17                       SET ORMSG(3)="Kernel Parameter Tools Error #"_+ORERROR_": "_$PIECE(ORERROR,U,2)

 +18                       DO BMES^XPDUTL(.ORMSG)

                       End DoDot:2

               End DoDot:1

 +19       if $GET(EXIT)

               QUIT 0

 +20       QUIT 1

SQOCONV() ;CONVERT EXISTING OUTPATIENT MEDICATION QUICK ORDERS INTO SUPPLY QUICK ORDERS

 +1        NEW DG,DLG,ORTEXT

 +2        SET DG("OUT")=$ORDER(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0))

 +3        IF +DG("OUT")=0

               Begin DoDot:1

 +4                SET ORTEXT(1)="Unable to find the OUTPATIENT MEDICATIONS display group in the DISPLAY GROUP"

 +5                SET ORTEXT(2)="file (#100.98). Please log a Remedy ticket for assistance."

 +6                DO BMES^XPDUTL(.ORTEXT)

               End DoDot:1

               QUIT 0

 +7        SET DG("SUPPLY")=$ORDER(^ORD(100.98,"B","SUPPLIES/DEVICES",0))

 +8        IF +DG("SUPPLY")=0

               Begin DoDot:1

 +9                SET ORTEXT(1)="Unable to find the SUPPLIES/DEVICES display group in the DISPLAY GROUP file"

 +10               SET ORTEXT(2)="(#100.98). Please log a Remedy ticket for assistance."

 +11               DO BMES^XPDUTL(.ORTEXT)

               End DoDot:1

               QUIT 0

 +12       SET DLG("ORDERABLE ITEM")=+$ORDER(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))

 +13       IF DLG("ORDERABLE ITEM")=0

               Begin DoDot:1

 +14               SET ORTEXT(1)="Unable to find the OR GTX ORDERABLE ITEM dialog in the ORDER DIALOG file"

 +15               SET ORTEXT(2)="(#101.41). Please log a Remedy ticket for assistance."

               End DoDot:1

               QUIT 0

 +16       NEW IEN,EXIT

 +17       SET IEN=0

FOR

               SET IEN=$ORDER(^ORD(101.41,IEN))

               if +$GET(IEN)=0!($GET(EXIT))

                   QUIT

               Begin DoDot:1

 +18      ;SKIP DISABLED QUICK ORDER (FIELD #3 NOT BLANK)

 +19               if $PIECE(^ORD(101.41,IEN,0),U,3)'=""

                       QUIT

 +20      ;SKIP NON-QUICK ORDER

 +21               if $PIECE(^ORD(101.41,IEN,0),U,4)'="Q"

                       QUIT

 +22      ;SKIP NON-OUTPATIENT MEDICATIONS

 +23               if $PIECE(^ORD(101.41,IEN,0),U,5)'=DG("OUT")

                       QUIT

 +24      ;DETERMINE IF THE ORDERABLE ITEM IS A SUPPLY

 +25               NEW RIEN,ORPHOI,ORDRGIEN,SET

 +26               SET RIEN=+$ORDER(^ORD(101.41,IEN,6,"D",DLG("ORDERABLE ITEM"),0))

 +27               if RIEN=0

                       QUIT

 +28               SET ORPHOI=+$PIECE($GET(^ORD(101.41,IEN,6,RIEN,1)),U,1)

 +29               if ORPHOI=0

                       QUIT

 +30               SET ORPHOI=$PIECE($GET(^ORD(101.43,ORPHOI,0)),U,2)

 +31               if $PIECE(ORPHOI,";",2)'="99PSP"

                       QUIT

 +32               DO DRGIEN^PSS50P7(+ORPHOI,,"ORSUPPLY")

 +33               if +^TMP($JOB,"ORSUPPLY",0)<1

                       QUIT

 +34               SET ORDRGIEN=0

FOR

                       SET ORDRGIEN=$ORDER(^TMP($JOB,"ORSUPPLY",ORDRGIEN))

                       if '+$GET(ORDRGIEN)!($GET(EXIT))!($GET(SET))

                           QUIT

                       Begin DoDot:2

 +35                       DO ZERO^PSS50(ORDRGIEN,,,,,"ORDRUG")

 +36                       if +^TMP($JOB,"ORDRUG",0)<1

                               QUIT

 +37                       IF $$ISSUPPLY(ORDRGIEN)

                               IF '$GET(SET)

                                   Begin DoDot:3

 +38      ;CHANGE THE DISPLAY GROUP

 +39                                   NEW FDA,ERROR

 +40                                   SET FDA(101.41,IEN_",",5)=DG("SUPPLY")

 +41                                   DO FILE^DIE("K","FDA","ERROR")

 +42                                   IF $DATA(ERROR)

                                           Begin DoDot:4

 +43                                           DO ERROR("Unable to convert quick order IEN #"_IEN,.ERROR)

 +44                                           SET EXIT=1

                                           End DoDot:4

                                           QUIT

 +45                                   SET SET=1

                                   End DoDot:3

                       End DoDot:2

               End DoDot:1

 +46       KILL ^TMP($JOB,"ORSUPPLY")

 +47       QUIT 1

ISSUPPLY(ORDRGIEN) ;DETERMINE IF DRUG IS A SUPPLY ITEM

 +1       ;PARAMETERS: ORDRGIEN=>DRUG IEN IN ^TMP($J,"ORDRUG") GLOBAL

 +2        if "^XA^XX^"[(U_$EXTRACT(^TMP($JOB,"ORDRUG",ORDRGIEN,2),1,2)_U)!(^TMP($JOB,"ORDRUG",ORDRGIEN,2)="DX900"&($GET(^TMP($JOB,"ORDRUG",ORDRGIEN,3))["S"))

               QUIT 1

 +3        QUIT 0

ERROR(TEXT,ERROR) ;OUTPUT FILEMAN ERROR MESSAGE(S)

 +1        NEW ORMSG,IDX

 +2        SET ORMSG(1)=" "

 +3        SET ORMSG(2)="ERROR: "_TEXT_"."

 +4        SET ORMSG(3)="VA FileMan Error #"_ERROR("DIERR",1)_":"

 +5        FOR IDX=1:1:+$ORDER(ERROR("DIERR",1,"TEXT","A"),-1)

               Begin DoDot:1

 +6                SET ORMSG(IDX+2)=ERROR("DIERR",1,"TEXT",IDX)

               End DoDot:1

 +7        DO BMES^XPDUTL(.ORMSG)

 +8        QUIT

ORY350A.m