ORY423 ;ISP/WAT post-init for OR*3.0*423; ;07/12/16 07:44
;;3.0;ORDER ENTRY/RESULTS REPORTING;**423**;Dec 17, 1997;Build 19
Q
POST ;post-init
N ORD,ORPOST,ORSTNUM,XPDIDTOT
D LAB
S ORPOST=1,ORSTNUM=1,XPDIDTOT=3
S ORD("GMRCOR CONSULT")=""
D EN^ORYDLG(423,.ORD),UPDATE^XPDID(ORSTNUM) S ORSTNUM=ORSTNUM+1
D ^ORY423ES,UPDATE^XPDID(ORSTNUM) S ORSTNUM=ORSTNUM+1
D QUEUE("File #100 index correction","MAIN^ORY423(""?"")","OE/RR FILE #100 CORRECT C & D INDEX",.ORSTNUM)
D UPDATE^XPDID(ORSTNUM)
S ORSTNUM=ORSTNUM+1
D BMES^XPDUTL("Moving supply quick orders...")
I $$SQOCONV^ORY423A D BMES^XPDUTL("DONE")
D UPDATE^XPDID(ORSTNUM)
Q
;
SENDDLG(ANAME) ; Return true if the current order dialog should be sent
I ANAME="GMRCOR CONSULT" Q 1
Q 0
;
QUEUE(ORMSG,ZTRTN,ZTDESC,ORCURITM) ;CREATE A SPECIFIED TASK
;PARAMETERS: ORMSG => STRING CONTAINING THE TEXT TO OUTPUT TO THE SCREEN
; ZTRTN => STRING CONTAINING THE ROUTINE TASKMAN SHOULD EXECUTE
; ZTDESC => STRING CONTAINING THE TASK'S DESCRIPTION
; ORCURITM => REFERENCE TO THE VARIABLE STORING THE NUMBER OF THE CURRENT ITEM
N ZTDTH,ZTIO,ZTSK
D BMES^XPDUTL("Queueing "_ORMSG_"...")
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10)
S ZTIO=""
D ^%ZTLOAD
I +$G(ZTSK)=0 D
.I $G(ORPOST) D BMES^XPDUTL("Unable to queue the "_ORMSG_"; file a help desk ticket for assistance.")
.E W "ERROR",!,"Unable to queue the "_ORMSG_"; file a help desk ticket for assistance.",!
E D
.I $G(ORPOST) D
..D BMES^XPDUTL("DONE - Task #"_ZTSK)
..D UPDATE^XPDID(ORCURITM)
..S ORCURITM=ORCURITM+1
.E W "DONE",!,"Task #"_ZTSK,!
Q
;
MAIN(ORIRDT) ;drive
N ORINSDT,ORSTAT,ORREP,ORRECP S ORINSDT=$$INSDT()
I $G(ORINSDT)'>0 D Q
. S ORREP(1)="The file #100 index correction in OR*3.0*423 did not run."
. S ORREP(2)="The install date for OR*3.0*389 was NOT found."
. S ORREP(3)="Please log a help desk ticket for assistance."
. S ORRECP(DUZ)=""
. S ORSTAT=$$MAIL^ORUTL("ORREP(","PATCH OR*3.0*423 ORDER INDEX CORRECTION STATUS",.ORRECP)
. S ZTREQ="@"
;use date as starting point for C/D index set
;if date is passed in, use that date
I $G(ORIRDT)'["?" S ORINSDT=ORIRDT
D REBUILD(ORINSDT)
Q
;
INSDT() ;get install dates for 389
N ORDATES S ORDATES=0
S ORDATES=$$INSTALDT^XPDUTL("OR*3.0*389",.ORSLT)
I ORDATES>0 S ORDATES=$O(ORSLT(""))
K ORSLT
Q ORDATES
;
REBUILD(ORDT) ;set missing index entries
Q:$G(ORDT)'>0
;set ORDT one day back to ensure no orders are skipped
S ORDT=$$FMADD^XLFDT(ORDT,-1)
N ORDTM,ORIFN,ORNODE,ORDLG,ORCNT,ORSTAT,ORREP,ORRECP S ORDTM=ORDT,ORIFN=0,ORCNT=0
F S ORDTM=$O(^OR(100,"AF",ORDTM)) H:'(ORCNT#10000) 1 Q:ORDTM=""!($G(ZTSTOP)=1) D
.F S ORIFN=$O(^OR(100,"AF",ORDTM,ORIFN)) Q:$G(ORIFN)'>0 D ;have to loop here; can have mult orders w/same time stamp
..;check for and add C and D x-refs
..I $D(^OR(100,ORIFN,0))'=0 D
...S ORNODE=^OR(100,ORIFN,0)
...S ORDLG=$P(ORNODE,U,5) Q:$G(ORDLG)=""
...;$D for index and set if missing
...Q:$D(^OR(100,"C",ORDLG,ORIFN))=1
...S ^OR(100,"C",$E(ORDLG,1,30),ORIFN)=""
..I $D(^OR(100,ORIFN,3))'=0 D
...S ORNODE=^OR(100,ORIFN,3),ORDLG=""
...S ORDLG=$P(ORNODE,U,4) Q:$G(ORDLG)=""
...;$D for index and set if missing
...Q:$D(^OR(100,"D",ORDLG,ORIFN))=1
...S ^OR(100,"D",$E(ORDLG,1,30),ORIFN)=""
.S ORCNT=ORCNT+1
.I ORCNT#1000=0,($$S^%ZTLOAD) N X S ZTSTOP=1,X=$$S^%ZTLOAD("File 100 C/D Index Correction")
;SEND STATUS EMAIL
I +$G(ZTSTOP)=0 D
.S ORREP(1)="The file #100 index correction from OR*3.0*423 was successfully completed."
E D
.K ORREP
.S ORREP(1)="The file #100 index correction in OR*3.0*423 has unexpectedly stopped."
.S ORREP(2)="If you or the system manager did not stop the process, please check the"
.S ORREP(3)="error log and file a help desk ticket for assistance."
.S ORREP(4)=""
.S ORREP(5)="To requeue the cleanup/conversion process, run RESTART^ORY423 from the"
.S ORREP(6)="programmer prompt and when asked for the starting order date, enter"
.S ORREP(7)=ORDTM
S ORRECP(DUZ)=""
S ORSTAT=$$MAIL^ORUTL("ORREP(","PATCH OR*3.0*423 ORDER INDEX CORRECTION STATUS",.ORRECP)
I +ORSTAT,($G(ZTSTOP)=1) D
.S ^XTMP("ORY423",0)=$$FMADD^XLFDT($$NOW^XLFDT,7,0,0,0)_U_$$NOW^XLFDT_U_"OR*3*423 POST-INSTALL DATA"
.S ^XTMP("ORY423","ORDER")=(ORDTM)
S ZTREQ="@"
Q
;
RESTART ;index redux
N DIC,Y,X,DTOUT,DUOUT
S DIC="^OR(100,",DIC(0)="AEQX",DIC("A")="ENTER THE STARTING ORDER DATE FROM THE STATUS EMAIL: "
D ^DIC
Q:+Y<1
W !,"Queueing re-index..."
D QUEUE("File #100 index correction","MAIN^ORY423("_+Y_")","OE/RR FILE #100 CORRECT C & D INDEX")
Q
;
LAB ;
N I,X,DAT,ENT,RTN,R
S DAT="ORRPW LAB OVERVIEW^ORRPW LAB ORDERS ALL^ORRPL LAB ORDERS ALL^ORRPL LAB ORDERS PEND^ORRPL LAB OVERVIEW"
S ENT="OV^ALL^ALL^PEND^OV",RTN="ORDV02D"
F I=1:1:5 S R=$P(DAT,"^",I) I $O(^ORD(101.24,"B",R,0)) S IFN=$O(^(0)) I $D(^ORD(101.24,IFN,0)),$D(^(2)) D
. ;W !,$P(DAT,"^",I),?25,$P(^(2),"^",8)_"^"_$P(^(2),"^",9)_"="_$P(ENT,"^",I)_"^"_RTN
. S $P(^ORD(101.24,IFN,2),"^",8,9)=$P(ENT,"^",I)_"^"_RTN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY423 5111 printed Apr 09, 2024@21:44:24 Page 2
ORY423 ;ISP/WAT post-init for OR*3.0*423; ;07/12/16 07:44
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**423**;Dec 17, 1997;Build 19
+2 QUIT
POST ;post-init
+1 NEW ORD,ORPOST,ORSTNUM,XPDIDTOT
+2 DO LAB
+3 SET ORPOST=1
SET ORSTNUM=1
SET XPDIDTOT=3
+4 SET ORD("GMRCOR CONSULT")=""
+5 DO EN^ORYDLG(423,.ORD)
DO UPDATE^XPDID(ORSTNUM)
SET ORSTNUM=ORSTNUM+1
+6 DO ^ORY423ES
DO UPDATE^XPDID(ORSTNUM)
SET ORSTNUM=ORSTNUM+1
+7 DO QUEUE("File #100 index correction","MAIN^ORY423(""?"")","OE/RR FILE #100 CORRECT C & D INDEX",.ORSTNUM)
+8 DO UPDATE^XPDID(ORSTNUM)
+9 SET ORSTNUM=ORSTNUM+1
+10 DO BMES^XPDUTL("Moving supply quick orders...")
+11 IF $$SQOCONV^ORY423A
DO BMES^XPDUTL("DONE")
+12 DO UPDATE^XPDID(ORSTNUM)
+13 QUIT
+14 ;
SENDDLG(ANAME) ; Return true if the current order dialog should be sent
+1 IF ANAME="GMRCOR CONSULT"
QUIT 1
+2 QUIT 0
+3 ;
QUEUE(ORMSG,ZTRTN,ZTDESC,ORCURITM) ;CREATE A SPECIFIED TASK
+1 ;PARAMETERS: ORMSG => STRING CONTAINING THE TEXT TO OUTPUT TO THE SCREEN
+2 ; ZTRTN => STRING CONTAINING THE ROUTINE TASKMAN SHOULD EXECUTE
+3 ; ZTDESC => STRING CONTAINING THE TASK'S DESCRIPTION
+4 ; ORCURITM => REFERENCE TO THE VARIABLE STORING THE NUMBER OF THE CURRENT ITEM
+5 NEW ZTDTH,ZTIO,ZTSK
+6 DO BMES^XPDUTL("Queueing "_ORMSG_"...")
+7 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10)
+8 SET ZTIO=""
+9 DO ^%ZTLOAD
+10 IF +$GET(ZTSK)=0
Begin DoDot:1
+11 IF $GET(ORPOST)
DO BMES^XPDUTL("Unable to queue the "_ORMSG_"; file a help desk ticket for assistance.")
+12 IF '$TEST
WRITE "ERROR",!,"Unable to queue the "_ORMSG_"; file a help desk ticket for assistance.",!
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 IF $GET(ORPOST)
Begin DoDot:2
+15 DO BMES^XPDUTL("DONE - Task #"_ZTSK)
+16 DO UPDATE^XPDID(ORCURITM)
+17 SET ORCURITM=ORCURITM+1
End DoDot:2
+18 IF '$TEST
WRITE "DONE",!,"Task #"_ZTSK,!
End DoDot:1
+19 QUIT
+20 ;
MAIN(ORIRDT) ;drive
+1 NEW ORINSDT,ORSTAT,ORREP,ORRECP
SET ORINSDT=$$INSDT()
+2 IF $GET(ORINSDT)'>0
Begin DoDot:1
+3 SET ORREP(1)="The file #100 index correction in OR*3.0*423 did not run."
+4 SET ORREP(2)="The install date for OR*3.0*389 was NOT found."
+5 SET ORREP(3)="Please log a help desk ticket for assistance."
+6 SET ORRECP(DUZ)=""
+7 SET ORSTAT=$$MAIL^ORUTL("ORREP(","PATCH OR*3.0*423 ORDER INDEX CORRECTION STATUS",.ORRECP)
+8 SET ZTREQ="@"
End DoDot:1
QUIT
+9 ;use date as starting point for C/D index set
+10 ;if date is passed in, use that date
+11 IF $GET(ORIRDT)'["?"
SET ORINSDT=ORIRDT
+12 DO REBUILD(ORINSDT)
+13 QUIT
+14 ;
INSDT() ;get install dates for 389
+1 NEW ORDATES
SET ORDATES=0
+2 SET ORDATES=$$INSTALDT^XPDUTL("OR*3.0*389",.ORSLT)
+3 IF ORDATES>0
SET ORDATES=$ORDER(ORSLT(""))
+4 KILL ORSLT
+5 QUIT ORDATES
+6 ;
REBUILD(ORDT) ;set missing index entries
+1 if $GET(ORDT)'>0
QUIT
+2 ;set ORDT one day back to ensure no orders are skipped
+3 SET ORDT=$$FMADD^XLFDT(ORDT,-1)
+4 NEW ORDTM,ORIFN,ORNODE,ORDLG,ORCNT,ORSTAT,ORREP,ORRECP
SET ORDTM=ORDT
SET ORIFN=0
SET ORCNT=0
+5 FOR
SET ORDTM=$ORDER(^OR(100,"AF",ORDTM))
if '(ORCNT#10000)
HANG 1
if ORDTM=""!($GET(ZTSTOP)=1)
QUIT
Begin DoDot:1
+6 ;have to loop here; can have mult orders w/same time stamp
FOR
SET ORIFN=$ORDER(^OR(100,"AF",ORDTM,ORIFN))
if $GET(ORIFN)'>0
QUIT
Begin DoDot:2
+7 ;check for and add C and D x-refs
+8 IF $DATA(^OR(100,ORIFN,0))'=0
Begin DoDot:3
+9 SET ORNODE=^OR(100,ORIFN,0)
+10 SET ORDLG=$PIECE(ORNODE,U,5)
if $GET(ORDLG)=""
QUIT
+11 ;$D for index and set if missing
+12 if $DATA(^OR(100,"C",ORDLG,ORIFN))=1
QUIT
+13 SET ^OR(100,"C",$EXTRACT(ORDLG,1,30),ORIFN)=""
End DoDot:3
+14 IF $DATA(^OR(100,ORIFN,3))'=0
Begin DoDot:3
+15 SET ORNODE=^OR(100,ORIFN,3)
SET ORDLG=""
+16 SET ORDLG=$PIECE(ORNODE,U,4)
if $GET(ORDLG)=""
QUIT
+17 ;$D for index and set if missing
+18 if $DATA(^OR(100,"D",ORDLG,ORIFN))=1
QUIT
+19 SET ^OR(100,"D",$EXTRACT(ORDLG,1,30),ORIFN)=""
End DoDot:3
End DoDot:2
+20 SET ORCNT=ORCNT+1
+21 IF ORCNT#1000=0
IF ($$S^%ZTLOAD)
NEW X
SET ZTSTOP=1
SET X=$$S^%ZTLOAD("File 100 C/D Index Correction")
End DoDot:1
+22 ;SEND STATUS EMAIL
+23 IF +$GET(ZTSTOP)=0
Begin DoDot:1
+24 SET ORREP(1)="The file #100 index correction from OR*3.0*423 was successfully completed."
End DoDot:1
+25 IF '$TEST
Begin DoDot:1
+26 KILL ORREP
+27 SET ORREP(1)="The file #100 index correction in OR*3.0*423 has unexpectedly stopped."
+28 SET ORREP(2)="If you or the system manager did not stop the process, please check the"
+29 SET ORREP(3)="error log and file a help desk ticket for assistance."
+30 SET ORREP(4)=""
+31 SET ORREP(5)="To requeue the cleanup/conversion process, run RESTART^ORY423 from the"
+32 SET ORREP(6)="programmer prompt and when asked for the starting order date, enter"
+33 SET ORREP(7)=ORDTM
End DoDot:1
+34 SET ORRECP(DUZ)=""
+35 SET ORSTAT=$$MAIL^ORUTL("ORREP(","PATCH OR*3.0*423 ORDER INDEX CORRECTION STATUS",.ORRECP)
+36 IF +ORSTAT
IF ($GET(ZTSTOP)=1)
Begin DoDot:1
+37 SET ^XTMP("ORY423",0)=$$FMADD^XLFDT($$NOW^XLFDT,7,0,0,0)_U_$$NOW^XLFDT_U_"OR*3*423 POST-INSTALL DATA"
+38 SET ^XTMP("ORY423","ORDER")=(ORDTM)
End DoDot:1
+39 SET ZTREQ="@"
+40 QUIT
+41 ;
RESTART ;index redux
+1 NEW DIC,Y,X,DTOUT,DUOUT
+2 SET DIC="^OR(100,"
SET DIC(0)="AEQX"
SET DIC("A")="ENTER THE STARTING ORDER DATE FROM THE STATUS EMAIL: "
+3 DO ^DIC
+4 if +Y<1
QUIT
+5 WRITE !,"Queueing re-index..."
+6 DO QUEUE("File #100 index correction","MAIN^ORY423("_+Y_")","OE/RR FILE #100 CORRECT C & D INDEX")
+7 QUIT
+8 ;
LAB ;
+1 NEW I,X,DAT,ENT,RTN,R
+2 SET DAT="ORRPW LAB OVERVIEW^ORRPW LAB ORDERS ALL^ORRPL LAB ORDERS ALL^ORRPL LAB ORDERS PEND^ORRPL LAB OVERVIEW"
+3 SET ENT="OV^ALL^ALL^PEND^OV"
SET RTN="ORDV02D"
+4 FOR I=1:1:5
SET R=$PIECE(DAT,"^",I)
IF $ORDER(^ORD(101.24,"B",R,0))
SET IFN=$ORDER(^(0))
IF $DATA(^ORD(101.24,IFN,0))
IF $DATA(^(2))
Begin DoDot:1
+5 ;W !,$P(DAT,"^",I),?25,$P(^(2),"^",8)_"^"_$P(^(2),"^",9)_"="_$P(ENT,"^",I)_"^"_RTN
+6 SET $PIECE(^ORD(101.24,IFN,2),"^",8,9)=$PIECE(ENT,"^",I)_"^"_RTN
End DoDot:1
+7 QUIT
