- 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 Jan 18, 2025@03:34:21 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