- 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 Dec 13, 2024@02:41:52 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