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

ORY92.m

Go to the documentation of this file.
  1. ORY92 ;SLC/MKB - Postinit for patch OR*3*92 ;1/22/01 08:46
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**92**;Dec 17, 1997
  1. ;
  1. POST ; -- postinit
  1. N ORMSG
  1. S ORMSG(1)=""
  1. S ORMSG(2)="This patch imports the ORDER TEXT and LAB TEST entries"
  1. S ORMSG(3)="from the OE/RR PRINT FIELDS file. As a result, the entries"
  1. S ORMSG(4)="in the OE/RR PRINT FORMAT file need to be recompiled."
  1. S ORMSG(5)=""
  1. S ORMSG(6)="**NOTE: If you have made local modifications to the compiled"
  1. S ORMSG(7)="code in the OE/RR PRINT FORMAT file they will be OVERWRITTEN."
  1. S ORMSG(8)=""
  1. S ORMSG(9)="Recompiling..."
  1. D MES^XPDUTL(.ORMSG) H 3
  1. D RECMPL^ORPR00 K ORMSG
  1. Q:'$$EXISTS(100,.11) ;postinit has run before
  1. N OREJ,ORI,ORX
  1. ; -update Natures of Order
  1. S OREJ=$O(^ORD(100.02,"C","X",0)) S:OREJ $P(^ORD(100.02,OREJ,1),U,2)=1
  1. S ORI=0 F S ORI=$O(^ORD(100.02,ORI)) Q:ORI'>0 S ORX=$S("EIXPVW"[$P($G(^(ORI,0)),U,2):1,1:0),$P(^(1),U,6)=ORX
  1. ; -queue conversion to run
  1. D TASK
  1. ; -delete DD for old Order Text field #.11
  1. N DIK,DA,DIU S DIK="^DD(100,",DA(1)=100,DA=.11 D ^DIK
  1. S DIU=100.011,DIU(0)="S" D EN^DIU2
  1. ; -update expert system
  1. D ^OCXRULE
  1. Q
  1. ;
  1. EXISTS(FILE,FLD) ; -- Returns 1 or 0, if FLD exists in FILE
  1. I '$G(FILE)!('$G(FLD)) Q 0
  1. N ORY,ORZ D FIELD^DID(FILE,FLD,,"LABEL","ORY")
  1. S ORZ=$L($G(ORY("LABEL")))
  1. Q ORZ
  1. ;
  1. TASK ; -- queue up conversion
  1. N ZTDESC,ZTRTN,ZTIO,ZTSAVE,ZTDTH,ZTSK,ORMSG
  1. S ORMSG(1)="Please queue the background job to move the Order Text field to its new",ORMSG(2)="location within the Orders file #100." D MES^XPDUTL(.ORMSG) K ORMSG
  1. S ZTDESC="Move order text within Orders file #100",ZTRTN="EN^ORY92"
  1. S ZTIO="",ZTSAVE("DUZ")="" D ^%ZTLOAD
  1. S ORMSG="Task "_$S($G(ZTSK):"#"_ZTSK,1:"not")_" started."
  1. D MES^XPDUTL(ORMSG)
  1. I '$G(ZTSK) D BMES^XPDUTL("Use TASK^ORY92 to queue this job to move the Order Text as soon as possible!")
  1. Q
  1. ;
  1. EN ; -- main conversion loop
  1. N ORIFN,ORCNT S ORIFN=+$$GET^XPAR("SYS","OR ORDER TEXT CONVERSION")
  1. F S ORIFN=$O(^OR(100,ORIFN)) Q:ORIFN'>0 D:$D(^(ORIFN,1)) Q:$G(ZTSTOP)
  1. . I $G(ORCNT)>1000,$D(ZTQUEUED) S:$$S^%ZTLOAD ZTSTOP=1 Q:$G(ZTSTOP) S ORCNT=0
  1. . D CNV(ORIFN) S ORCNT=+$G(ORCNT)+1
  1. . D EN^XPAR("SYS","OR ORDER TEXT CONVERSION",1,ORIFN) ;save last order#
  1. D MAIL ;send message
  1. Q
  1. ;
  1. CNV(ORDER) ; -- move text of ORDER
  1. N ORDT,HDR,ORI S ORDER=+$G(ORDER)
  1. Q:ORDER'>0 Q:'$O(^OR(100,ORDER,1,0)) ;no order or text to convert
  1. F ORI=1:1:10 L +^OR(100,ORDER):1 Q:$T H 2
  1. Q:'$T M ^TMP("ORTX",$J,ORDER)=^OR(100,ORDER) ;work in ^TMP then re-save
  1. M ^TMP("ORTX",$J,ORDER,8,1,.1)=^TMP("ORTX",$J,ORDER,1) ;move text
  1. K ^TMP("ORTX",$J,ORDER,1) ;clear old text location
  1. ; -Fix format of header node if needed
  1. S ORDT=$P($P($G(^TMP("ORTX",$J,+ORDER,0)),U,7),"."),HDR=$G(^(8,1,.1,0))
  1. S $P(HDR,U,2)="",$P(HDR,U,5,6)=ORDT_U,^TMP("ORTX",$J,ORDER,8,1,.1,0)=HDR
  1. ; -set all actions to use text in 1, merge & unlock order
  1. S ORI=0 F S ORI=$O(^TMP("ORTX",$J,ORDER,8,ORI)) Q:ORI'>0 S $P(^(ORI,0),U,14)=1
  1. K ^OR(100,ORDER) M ^OR(100,ORDER)=^TMP("ORTX",$J,ORDER)
  1. L -^OR(100,ORDER) K ^TMP("ORTX",$J,ORDER)
  1. Q
  1. ;
  1. MAIL ; -- Send completion message to user who initiated conversion
  1. N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,ORTXT
  1. S XMDUZ="PATCH OR*3*92 CONVERSION",XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
  1. S ORTXT(1)="The order text conversion of patch OR*3*92"_$S($G(ZTSK):" (Task #"_ZTSK_")",1:"")
  1. S ORTXT(2)="completed at "_$$FMTE^XLFDT($$NOW^XLFDT)_"."
  1. S XMTEXT="ORTXT(",XMSUB="PATCH OR*3*92 CONVERSION COMPLETED"
  1. D ^XMD
  1. Q