Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORY423

ORY423.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. POST ;post-init
  1. N ORD,ORPOST,ORSTNUM,XPDIDTOT
  1. D LAB
  1. S ORPOST=1,ORSTNUM=1,XPDIDTOT=3
  1. S ORD("GMRCOR CONSULT")=""
  1. D EN^ORYDLG(423,.ORD),UPDATE^XPDID(ORSTNUM) S ORSTNUM=ORSTNUM+1
  1. D ^ORY423ES,UPDATE^XPDID(ORSTNUM) S ORSTNUM=ORSTNUM+1
  1. D QUEUE("File #100 index correction","MAIN^ORY423(""?"")","OE/RR FILE #100 CORRECT C & D INDEX",.ORSTNUM)
  1. D UPDATE^XPDID(ORSTNUM)
  1. S ORSTNUM=ORSTNUM+1
  1. D BMES^XPDUTL("Moving supply quick orders...")
  1. I $$SQOCONV^ORY423A D BMES^XPDUTL("DONE")
  1. D UPDATE^XPDID(ORSTNUM)
  1. Q
  1. ;
  1. SENDDLG(ANAME) ; Return true if the current order dialog should be sent
  1. I ANAME="GMRCOR CONSULT" Q 1
  1. Q 0
  1. ;
  1. QUEUE(ORMSG,ZTRTN,ZTDESC,ORCURITM) ;CREATE A SPECIFIED TASK
  1. ;PARAMETERS: ORMSG => STRING CONTAINING THE TEXT TO OUTPUT TO THE SCREEN
  1. ; ZTRTN => STRING CONTAINING THE ROUTINE TASKMAN SHOULD EXECUTE
  1. ; ZTDESC => STRING CONTAINING THE TASK'S DESCRIPTION
  1. ; ORCURITM => REFERENCE TO THE VARIABLE STORING THE NUMBER OF THE CURRENT ITEM
  1. N ZTDTH,ZTIO,ZTSK
  1. D BMES^XPDUTL("Queueing "_ORMSG_"...")
  1. S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10)
  1. S ZTIO=""
  1. D ^%ZTLOAD
  1. I +$G(ZTSK)=0 D
  1. .I $G(ORPOST) D BMES^XPDUTL("Unable to queue the "_ORMSG_"; file a help desk ticket for assistance.")
  1. .E W "ERROR",!,"Unable to queue the "_ORMSG_"; file a help desk ticket for assistance.",!
  1. E D
  1. .I $G(ORPOST) D
  1. ..D BMES^XPDUTL("DONE - Task #"_ZTSK)
  1. ..D UPDATE^XPDID(ORCURITM)
  1. ..S ORCURITM=ORCURITM+1
  1. .E W "DONE",!,"Task #"_ZTSK,!
  1. Q
  1. ;
  1. MAIN(ORIRDT) ;drive
  1. N ORINSDT,ORSTAT,ORREP,ORRECP S ORINSDT=$$INSDT()
  1. I $G(ORINSDT)'>0 D Q
  1. . S ORREP(1)="The file #100 index correction in OR*3.0*423 did not run."
  1. . S ORREP(2)="The install date for OR*3.0*389 was NOT found."
  1. . S ORREP(3)="Please log a help desk ticket for assistance."
  1. . S ORRECP(DUZ)=""
  1. . S ORSTAT=$$MAIL^ORUTL("ORREP(","PATCH OR*3.0*423 ORDER INDEX CORRECTION STATUS",.ORRECP)
  1. . S ZTREQ="@"
  1. ;use date as starting point for C/D index set
  1. ;if date is passed in, use that date
  1. I $G(ORIRDT)'["?" S ORINSDT=ORIRDT
  1. D REBUILD(ORINSDT)
  1. Q
  1. ;
  1. INSDT() ;get install dates for 389
  1. N ORDATES S ORDATES=0
  1. S ORDATES=$$INSTALDT^XPDUTL("OR*3.0*389",.ORSLT)
  1. I ORDATES>0 S ORDATES=$O(ORSLT(""))
  1. K ORSLT
  1. Q ORDATES
  1. ;
  1. REBUILD(ORDT) ;set missing index entries
  1. Q:$G(ORDT)'>0
  1. ;set ORDT one day back to ensure no orders are skipped
  1. S ORDT=$$FMADD^XLFDT(ORDT,-1)
  1. N ORDTM,ORIFN,ORNODE,ORDLG,ORCNT,ORSTAT,ORREP,ORRECP S ORDTM=ORDT,ORIFN=0,ORCNT=0
  1. F S ORDTM=$O(^OR(100,"AF",ORDTM)) H:'(ORCNT#10000) 1 Q:ORDTM=""!($G(ZTSTOP)=1) D
  1. .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
  1. ..;check for and add C and D x-refs
  1. ..I $D(^OR(100,ORIFN,0))'=0 D
  1. ...S ORNODE=^OR(100,ORIFN,0)
  1. ...S ORDLG=$P(ORNODE,U,5) Q:$G(ORDLG)=""
  1. ...;$D for index and set if missing
  1. ...Q:$D(^OR(100,"C",ORDLG,ORIFN))=1
  1. ...S ^OR(100,"C",$E(ORDLG,1,30),ORIFN)=""
  1. ..I $D(^OR(100,ORIFN,3))'=0 D
  1. ...S ORNODE=^OR(100,ORIFN,3),ORDLG=""
  1. ...S ORDLG=$P(ORNODE,U,4) Q:$G(ORDLG)=""
  1. ...;$D for index and set if missing
  1. ...Q:$D(^OR(100,"D",ORDLG,ORIFN))=1
  1. ...S ^OR(100,"D",$E(ORDLG,1,30),ORIFN)=""
  1. .S ORCNT=ORCNT+1
  1. .I ORCNT#1000=0,($$S^%ZTLOAD) N X S ZTSTOP=1,X=$$S^%ZTLOAD("File 100 C/D Index Correction")
  1. ;SEND STATUS EMAIL
  1. I +$G(ZTSTOP)=0 D
  1. .S ORREP(1)="The file #100 index correction from OR*3.0*423 was successfully completed."
  1. E D
  1. .K ORREP
  1. .S ORREP(1)="The file #100 index correction in OR*3.0*423 has unexpectedly stopped."
  1. .S ORREP(2)="If you or the system manager did not stop the process, please check the"
  1. .S ORREP(3)="error log and file a help desk ticket for assistance."
  1. .S ORREP(4)=""
  1. .S ORREP(5)="To requeue the cleanup/conversion process, run RESTART^ORY423 from the"
  1. .S ORREP(6)="programmer prompt and when asked for the starting order date, enter"
  1. .S ORREP(7)=ORDTM
  1. S ORRECP(DUZ)=""
  1. S ORSTAT=$$MAIL^ORUTL("ORREP(","PATCH OR*3.0*423 ORDER INDEX CORRECTION STATUS",.ORRECP)
  1. I +ORSTAT,($G(ZTSTOP)=1) D
  1. .S ^XTMP("ORY423",0)=$$FMADD^XLFDT($$NOW^XLFDT,7,0,0,0)_U_$$NOW^XLFDT_U_"OR*3*423 POST-INSTALL DATA"
  1. .S ^XTMP("ORY423","ORDER")=(ORDTM)
  1. S ZTREQ="@"
  1. Q
  1. ;
  1. RESTART ;index redux
  1. N DIC,Y,X,DTOUT,DUOUT
  1. S DIC="^OR(100,",DIC(0)="AEQX",DIC("A")="ENTER THE STARTING ORDER DATE FROM THE STATUS EMAIL: "
  1. D ^DIC
  1. Q:+Y<1
  1. W !,"Queueing re-index..."
  1. D QUEUE("File #100 index correction","MAIN^ORY423("_+Y_")","OE/RR FILE #100 CORRECT C & D INDEX")
  1. Q
  1. ;
  1. LAB ;
  1. N I,X,DAT,ENT,RTN,R
  1. S DAT="ORRPW LAB OVERVIEW^ORRPW LAB ORDERS ALL^ORRPL LAB ORDERS ALL^ORRPL LAB ORDERS PEND^ORRPL LAB OVERVIEW"
  1. S ENT="OV^ALL^ALL^PEND^OV",RTN="ORDV02D"
  1. 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
  1. . ;W !,$P(DAT,"^",I),?25,$P(^(2),"^",8)_"^"_$P(^(2),"^",9)_"="_$P(ENT,"^",I)_"^"_RTN
  1. . S $P(^ORD(101.24,IFN,2),"^",8,9)=$P(ENT,"^",I)_"^"_RTN
  1. Q