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