ORQO441P ;EPIP/RTW - QUICK ORDER POST INSTALL ; 12/29/17 10:03am
;;3.0;ORDER ENTRY/RESULTS REPORTING;**441**;Dec 17, 1997;Build 52
;ICR# Type Description
;----- ---- -------------------------------------
;1472 Sup RESCH^XUTMOPT [allows creation of new record in 19.2]
;1157 Sup $$LKOPT^XPDMENU
;2053 Sup FILE^DIE
;10103 Sup $$FMTE^XLFDT
;10141 Sup MES^XPDUTL
;5033 CS Lookup name in file 8925.1 [OR not a subscriber]
;10013 Sup ^DIk Multiple entry points to support entry deletion and file reindexing.
;
I $D(^TIU(8925.1,"B","OR QUICK ORDER AUDIT")) D OBJECT1
I $D(^TIU(8925.1,"B","OR QUICK ORDER AUDIT(ALT)")) D OBJECT2
D TASK,OBJECT3,ORFUMPS
Q
TASK ;
N ORQAOPTB,ORQAOPTN,DA,DIE,DR,X,ORQWHEN
S ORQWHEN=DT_"@2301" ;ORQWHEN IS THE QUICK ORDER NIGHTLY TASK Date Time
W !,"The 'QUICK ORDER NIGHTLY BG' option is scheduled to run at: "
D RESCH^XUTMOPT("OR QUICK ORDER NIGHTLY BG",ORQWHEN,"","1D","L",".ORQA_ERROR")
S ORQAOPTN=$$FIND1^DIC(19,"","X","OR QUICK ORDER NIGHTLY BG","B")
S ORQAOPTB=0,ORQAOPTB=+$P($Q(^DIC(19.2,"B",ORQAOPTN,ORQAOPTB)),",",4) W ORQAOPTB
S DIE="^DIC(19.2,",DR="11///.5",DA=ORQAOPTB D ^DIE
Q
;
OBJECT1 ;
N ORBIEN,DIK,DA
I $D(^TIU(8925.1,"B","OR QUICK ORDER AUDIT")) S ORBIEN=0,ORBIEN=$O(^TIU(8925.1,"B","OR QUICK ORDER AUDIT",ORBIEN)) D
. S DIK="^TIU(8925.1,"
. S DA=ORBIEN
. D ^DIK
Q
OBJECT2 ;
N ORBIEN,DIK,DA
I $D(^TIU(8925.1,"B","OR QUICK ORDER AUDIT(ALT)")) S ORBIEN=0,ORBIEN=$O(^TIU(8925.1,"B","OR QUICK ORDER AUDIT(ALT)",ORBIEN)) D
. S DIK="^TIU(8925.1,"
. S DA=ORBIEN
. D ^DIK
Q
OBJECT3 ;
N OROBJECT,ORTYPE,ORMETHOD,ORPEROWN,ORCLOWN,ORSTATUS,OBOBFDA,ORUSRCL
S ORUSRCL=0,ORUSRCL=$O(^USR(8930,"B","CLINICAL COORDINATOR",ORUSRCL))
S OROBJECT="" F OROBJECT="OR QUICK ORDER AUDIT","OR QUICK ORDER AUDIT(ALT)" Q:OROBJECT="" D
.Q:$D(^TIU(8925.1,"B",OROBJECT))
.S ORTYPE="OBJECT",ORPEROWN="POSTMASTER",ORCLOWN="CLINICAL COORDINATOR"
.S:OROBJECT'["ALT" ORMETHOD="S X=$$AUD^ORQOAUIC(DFN,""P"",$P($G(X0),U,1))"
.S:OROBJECT["ALT" ORMETHOD="S X=$$AUD^ORQOAUIC(DFN,""A"",$P($G(X0),U,1))"
.S FDA(8925.1,"+1,",.01)=OROBJECT
.S FDA(8925.1,"+1,",.03)=OROBJECT
.S FDA(8925.1,"+1,",.04)="O"
.S FDA(8925.1,"+1,",.05)=.5
.S FDA(8925.1,"+1,",.06)=ORUSRCL
.S FDA(8925.1,"+1,",.07)="11"
.S FDA(8925.1,"+1,",9)=ORMETHOD
.S FDA(8925.1,"+1,",99)=$H
.;
.D UPDATE^DIE("","FDA","FDAIEN","MSG")
.K FDA,FDAIEN
I $D(MSG) D Q
. S ORX="TIU Object creation failed. The following error message was returned:"
. W !
. D MES^XPDUTL(ORX)
S ORX="TIU Object created successfully."
D MES^XPDUTL(ORX)
Q
ORFUMPS ;
N ORDATA,ORDNAME,ORDNUM,ORLINE,ORNEW
S ORDNAME="" F S ORDNAME=$O(^ORD(101.41,"B",ORDNAME)) Q:ORDNAME="" D
. S ORDNUM=0 F S ORDNUM=$O(^ORD(101.41,"B",ORDNAME,ORDNUM)) Q:'ORDNUM D
. . Q:'$D(^ORD(101.41,ORDNUM,6,3,2,1))
. . S ORLINE=0 F S ORLINE=$O(^ORD(101.41,ORDNUM,6,3,2,ORLINE)) Q:'ORLINE D
. . . S ORDATA=$G(^ORD(101.41,ORDNUM,6,3,2,ORLINE,0)) Q:ORDATA=""
. . . I ORDATA["|ZZ QUICK ORDER AUDIT|" D Q
. . . . S ORNEW=$$STUFF(ORDATA,"ZZ QUICK ORDER AUDIT","OR QUICK ORDER AUDIT")
. . . . S ^ORD(101.41,ORDNUM,6,3,2,ORLINE,0)=ORNEW
. . . I ORDATA["|ZZ QUICK ORDER AUDIT (ALT)|" D Q
. . . . S ORNEW=$$STUFF(ORDATA,"ZZ QUICK ORDER AUDIT (ALT)","OR QUICK ORDER AUDIT(ALT)")
. . . . S ^ORD(101.41,ORDNUM,6,3,2,ORLINE,0)=ORNEW
. . . I ORDATA["|ZZ QUICK ORDER AUDIT (CI)|" D Q
. . . . S ORNEW=$$STUFF(ORDATA,"ZZ QUICK ORDER AUDIT (CI)","OR QUICK ORDER AUDIT")
. . . . S ^ORD(101.41,ORDNUM,6,3,2,ORLINE,0)=ORNEW
. . . I ORDATA["|ZZ QUICK ORDER AUDIT (CI-ALT)|" D Q
. . . . S ORNEW=$$STUFF(ORDATA,"ZZ QUICK ORDER AUDIT (CI-ALT)","OR QUICK ORDER AUDIT(ALT)")
. . . . S ^ORD(101.41,ORDNUM,6,3,2,ORLINE,0)=ORNEW
. . . I ORDATA["|ZZ QUICK ORDER AUDIT (NE)|" D Q
. . . . S ORNEW=$$STUFF(ORDATA,"ZZ QUICK ORDER AUDIT (NE)","OR QUICK ORDER AUDIT")
. . . . S ^ORD(101.41,ORDNUM,6,3,2,ORLINE,0)=ORNEW
. . . I ORDATA["|ZZ QUICK ORDER AUDIT (NE-ALT)|" D Q
. . . . S ORNEW=$$STUFF(ORDATA,"ZZ QUICK ORDER AUDIT (NE-ALT)","OR QUICK ORDER AUDIT(ALT)")
. . . . S ^ORD(101.41,ORDNUM,6,3,2,ORLINE,0)=ORNEW
;
Q
;
STUFF(ORSTR,ORFROM,ORTO) ;
;
N ORA,ORB,ORC
;
S ORA=$P(ORSTR,"|"),ORB=$P(ORSTR,"|",2),ORC=$P(ORSTR,"|",3)
;
I ORA=ORFROM Q ORTO_"|"_ORB_"|"_ORC
I ORB=ORFROM Q ORA_"|"_ORTO_"|"_ORC
I ORC=ORFROM Q ORA_"|"_ORB_"|"_ORTO
;
Q ORSTR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQO441P 4456 printed Dec 13, 2024@02:33:12 Page 2
ORQO441P ;EPIP/RTW - QUICK ORDER POST INSTALL ; 12/29/17 10:03am
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**441**;Dec 17, 1997;Build 52
+2 ;ICR# Type Description
+3 ;----- ---- -------------------------------------
+4 ;1472 Sup RESCH^XUTMOPT [allows creation of new record in 19.2]
+5 ;1157 Sup $$LKOPT^XPDMENU
+6 ;2053 Sup FILE^DIE
+7 ;10103 Sup $$FMTE^XLFDT
+8 ;10141 Sup MES^XPDUTL
+9 ;5033 CS Lookup name in file 8925.1 [OR not a subscriber]
+10 ;10013 Sup ^DIk Multiple entry points to support entry deletion and file reindexing.
+11 ;
+12 IF $DATA(^TIU(8925.1,"B","OR QUICK ORDER AUDIT"))
DO OBJECT1
+13 IF $DATA(^TIU(8925.1,"B","OR QUICK ORDER AUDIT(ALT)"))
DO OBJECT2
+14 DO TASK
DO OBJECT3
DO ORFUMPS
+15 QUIT
TASK ;
+1 NEW ORQAOPTB,ORQAOPTN,DA,DIE,DR,X,ORQWHEN
+2 ;ORQWHEN IS THE QUICK ORDER NIGHTLY TASK Date Time
SET ORQWHEN=DT_"@2301"
+3 WRITE !,"The 'QUICK ORDER NIGHTLY BG' option is scheduled to run at: "
+4 DO RESCH^XUTMOPT("OR QUICK ORDER NIGHTLY BG",ORQWHEN,"","1D","L",".ORQA_ERROR")
+5 SET ORQAOPTN=$$FIND1^DIC(19,"","X","OR QUICK ORDER NIGHTLY BG","B")
+6 SET ORQAOPTB=0
SET ORQAOPTB=+$PIECE($QUERY(^DIC(19.2,"B",ORQAOPTN,ORQAOPTB)),",",4)
WRITE ORQAOPTB
+7 SET DIE="^DIC(19.2,"
SET DR="11///.5"
SET DA=ORQAOPTB
DO ^DIE
+8 QUIT
+9 ;
OBJECT1 ;
+1 NEW ORBIEN,DIK,DA
+2 IF $DATA(^TIU(8925.1,"B","OR QUICK ORDER AUDIT"))
SET ORBIEN=0
SET ORBIEN=$ORDER(^TIU(8925.1,"B","OR QUICK ORDER AUDIT",ORBIEN))
Begin DoDot:1
+3 SET DIK="^TIU(8925.1,"
+4 SET DA=ORBIEN
+5 DO ^DIK
End DoDot:1
+6 QUIT
OBJECT2 ;
+1 NEW ORBIEN,DIK,DA
+2 IF $DATA(^TIU(8925.1,"B","OR QUICK ORDER AUDIT(ALT)"))
SET ORBIEN=0
SET ORBIEN=$ORDER(^TIU(8925.1,"B","OR QUICK ORDER AUDIT(ALT)",ORBIEN))
Begin DoDot:1
+3 SET DIK="^TIU(8925.1,"
+4 SET DA=ORBIEN
+5 DO ^DIK
End DoDot:1
+6 QUIT
OBJECT3 ;
+1 NEW OROBJECT,ORTYPE,ORMETHOD,ORPEROWN,ORCLOWN,ORSTATUS,OBOBFDA,ORUSRCL
+2 SET ORUSRCL=0
SET ORUSRCL=$ORDER(^USR(8930,"B","CLINICAL COORDINATOR",ORUSRCL))
+3 SET OROBJECT=""
FOR OROBJECT="OR QUICK ORDER AUDIT","OR QUICK ORDER AUDIT(ALT)"
if OROBJECT=""
QUIT
Begin DoDot:1
+4 if $DATA(^TIU(8925.1,"B",OROBJECT))
QUIT
+5 SET ORTYPE="OBJECT"
SET ORPEROWN="POSTMASTER"
SET ORCLOWN="CLINICAL COORDINATOR"
+6 if OROBJECT'["ALT"
SET ORMETHOD="S X=$$AUD^ORQOAUIC(DFN,""P"",$P($G(X0),U,1))"
+7 if OROBJECT["ALT"
SET ORMETHOD="S X=$$AUD^ORQOAUIC(DFN,""A"",$P($G(X0),U,1))"
+8 SET FDA(8925.1,"+1,",.01)=OROBJECT
+9 SET FDA(8925.1,"+1,",.03)=OROBJECT
+10 SET FDA(8925.1,"+1,",.04)="O"
+11 SET FDA(8925.1,"+1,",.05)=.5
+12 SET FDA(8925.1,"+1,",.06)=ORUSRCL
+13 SET FDA(8925.1,"+1,",.07)="11"
+14 SET FDA(8925.1,"+1,",9)=ORMETHOD
+15 SET FDA(8925.1,"+1,",99)=$HOROLOG
+16 ;
+17 DO UPDATE^DIE("","FDA","FDAIEN","MSG")
+18 KILL FDA,FDAIEN
End DoDot:1
+19 IF $DATA(MSG)
Begin DoDot:1
+20 SET ORX="TIU Object creation failed. The following error message was returned:"
+21 WRITE !
+22 DO MES^XPDUTL(ORX)
End DoDot:1
QUIT
+23 SET ORX="TIU Object created successfully."
+24 DO MES^XPDUTL(ORX)
+25 QUIT
ORFUMPS ;
+1 NEW ORDATA,ORDNAME,ORDNUM,ORLINE,ORNEW
+2 SET ORDNAME=""
FOR
SET ORDNAME=$ORDER(^ORD(101.41,"B",ORDNAME))
if ORDNAME=""
QUIT
Begin DoDot:1
+3 SET ORDNUM=0
FOR
SET ORDNUM=$ORDER(^ORD(101.41,"B",ORDNAME,ORDNUM))
if 'ORDNUM
QUIT
Begin DoDot:2
+4 if '$DATA(^ORD(101.41,ORDNUM,6,3,2,1))
QUIT
+5 SET ORLINE=0
FOR
SET ORLINE=$ORDER(^ORD(101.41,ORDNUM,6,3,2,ORLINE))
if 'ORLINE
QUIT
Begin DoDot:3
+6 SET ORDATA=$GET(^ORD(101.41,ORDNUM,6,3,2,ORLINE,0))
if ORDATA=""
QUIT
+7 IF ORDATA["|ZZ QUICK ORDER AUDIT|"
Begin DoDot:4
+8 SET ORNEW=$$STUFF(ORDATA,"ZZ QUICK ORDER AUDIT","OR QUICK ORDER AUDIT")
+9 SET ^ORD(101.41,ORDNUM,6,3,2,ORLINE,0)=ORNEW
End DoDot:4
QUIT
+10 IF ORDATA["|ZZ QUICK ORDER AUDIT (ALT)|"
Begin DoDot:4
+11 SET ORNEW=$$STUFF(ORDATA,"ZZ QUICK ORDER AUDIT (ALT)","OR QUICK ORDER AUDIT(ALT)")
+12 SET ^ORD(101.41,ORDNUM,6,3,2,ORLINE,0)=ORNEW
End DoDot:4
QUIT
+13 IF ORDATA["|ZZ QUICK ORDER AUDIT (CI)|"
Begin DoDot:4
+14 SET ORNEW=$$STUFF(ORDATA,"ZZ QUICK ORDER AUDIT (CI)","OR QUICK ORDER AUDIT")
+15 SET ^ORD(101.41,ORDNUM,6,3,2,ORLINE,0)=ORNEW
End DoDot:4
QUIT
+16 IF ORDATA["|ZZ QUICK ORDER AUDIT (CI-ALT)|"
Begin DoDot:4
+17 SET ORNEW=$$STUFF(ORDATA,"ZZ QUICK ORDER AUDIT (CI-ALT)","OR QUICK ORDER AUDIT(ALT)")
+18 SET ^ORD(101.41,ORDNUM,6,3,2,ORLINE,0)=ORNEW
End DoDot:4
QUIT
+19 IF ORDATA["|ZZ QUICK ORDER AUDIT (NE)|"
Begin DoDot:4
+20 SET ORNEW=$$STUFF(ORDATA,"ZZ QUICK ORDER AUDIT (NE)","OR QUICK ORDER AUDIT")
+21 SET ^ORD(101.41,ORDNUM,6,3,2,ORLINE,0)=ORNEW
End DoDot:4
QUIT
+22 IF ORDATA["|ZZ QUICK ORDER AUDIT (NE-ALT)|"
Begin DoDot:4
+23 SET ORNEW=$$STUFF(ORDATA,"ZZ QUICK ORDER AUDIT (NE-ALT)","OR QUICK ORDER AUDIT(ALT)")
+24 SET ^ORD(101.41,ORDNUM,6,3,2,ORLINE,0)=ORNEW
End DoDot:4
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 QUIT
+27 ;
STUFF(ORSTR,ORFROM,ORTO) ;
+1 ;
+2 NEW ORA,ORB,ORC
+3 ;
+4 SET ORA=$PIECE(ORSTR,"|")
SET ORB=$PIECE(ORSTR,"|",2)
SET ORC=$PIECE(ORSTR,"|",3)
+5 ;
+6 IF ORA=ORFROM
QUIT ORTO_"|"_ORB_"|"_ORC
+7 IF ORB=ORFROM
QUIT ORA_"|"_ORTO_"|"_ORC
+8 IF ORC=ORFROM
QUIT ORA_"|"_ORB_"|"_ORTO
+9 ;
+10 QUIT ORSTR