- LR343 ;DALOI/JDB - LR*5.2*343 KIDS ROUTINE
- ;;5.2;LAB SERVICE;**343**;Sep 27, 1994;Build 1
- ;
- ; Send email if #69.9 fields set to Yes
- ; Set LR7O MOVEMENT EVENT protocols DISABLE and ACTION fields
- ; Pause X minutes so any running protocols can clear
- ; KIDS deletes LR7OEVNT routine
- ; KIDS deletes LR7O MOVEMENT EVENT protocols
- ; Delete data from #69.9 fields
- ; Delete #69.9 fields DD
- ;
- ;
- EN ;
- ; Environment Check
- ; Does not prevent loading of the transport global.
- ;
- D CLEAN
- D CHECK
- I $G(XPDQUIT) D Q ;
- . W !,$$CJ^XLFSTR("Environment check failed",$G(IOM,80))
- ;
- W !,$$CJ^XLFSTR("Environment is okay",$G(IOM,80))
- D ALERT("Installation of patch "_$G(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($H))
- I '$G(XPDENV) D Q
- . D ALERT("Transport global for patch "_$G(XPDNM,"Unknown patch")_" loaded on "_$$HTE^XLFDT($H))
- . D MSGADD("Sending transport global loaded alert to mail group G.LMI")
- Q
- ;
- CHECK ;
- ; Perform environment check
- N POP
- ; Is Home device defined
- ; Need Home device so "task install" option is displayed
- S POP=0 S IOP="",%ZIS=0 D ^%ZIS
- I POP D Q
- . S XPDQUIT=2
- . W !,$$CJ^XLFSTR("*** Home device is not defined ***",$G(IOM,80))
- ;
- ; Device Defined
- I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D Q
- . W !,$$CJ^XLFSTR("*** Terminal Device is not defined ***",$G(IOM,80))
- . S XPDQUIT=2
- ;
- ; DUZ setup
- I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D Q
- . W !,$$CJ^XLFSTR("*** Please log in to set variables ***",$G(IOM,80))
- . S XPDQUIT=2
- ;
- ; Active User
- I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D Q
- . W !,$$CJ^XLFSTR("*** You are not a valid user on this system ***",$G(IOM,80))
- . S XPDQUIT=2
- ;
- ; KIDS default answer to "Disable Protocols...."
- S XPDDIQ("XPZ1")=0 ;;Dont allow disabling options
- S XPDDIQ("XPZ1","B")="NO"
- Q
- ;
- PRE ;
- ; KIDS Pre Install
- ; Check that install was tasked
- ; Check if any File #69.9 fields are set to "YES" If so send
- ; notification email.
- ; Disable Lab Protocols (set DISABLED field and set ACTION to Q)
- ; Hang so current processes started by protocols can end
- N IEN,ERR,PREERR,RECIPS,BODY,VALS,STR
- S PREERR=0
- D MSGADD("Pre install started at "_$$HTE^XLFDT($H))
- ;
- ; Was install tasked? Quit if not
- I '$D(ZTQUEUED) I $G(IO("Q"))="" D Q
- . S XPDQUIT=2
- . S XPDABORT=2
- . D MSGADD("*** THIS INSTALLATION MUST BE TASKED ***")
- . D MSGADD("",0)
- . D MSGADD("Refer to the Patch Installation instructions",0)
- . D MSGADD("for details concerning re-running the install.",0)
- . D CLEAN
- ;
- ; check DD field values and send email if any are YES
- S VALS=$$GETVALS()
- I VALS>0 D ;
- . S STR="File #69.9 LABORATORY SITE has one or more fields that were set to YES."
- . D BLDBODY(STR,.BODY)
- . S STR=" #150.3 CANCEL ON ADMIT set to "_$S($E(VALS,1,1):"YES",1:"NO")
- . D BLDBODY(STR,.BODY)
- . S STR=" #150.4 CANCEL ON DISCHARGE set to "_$S($E(VALS,2,2):"YES",1:"NO")
- . D BLDBODY(STR,.BODY)
- . S STR=" #150.5 CANCEL ON SPECIALTY set to "_$S($E(VALS,3,3):"YES",1:"NO")
- . D BLDBODY(STR,.BODY)
- . D BLDBODY(" ",.BODY)
- . S STR="One or more DC fields of File #69.9 are set to Yes. These fields should have been set to No according to guidelines issued with the release of OR*3*142 and OR*3*141."
- . S STR=STR_" Facilities would be advised to use the functionality provided in file #100.6 (released with OR*3*142) to maintain the ability to auto discontinue laboratory orders upon a patient movement."
- . S STR=STR_" Please check your configurations to ensure that this migration has occurred."
- . D BLDBODY(STR,.BODY)
- . S RECIPS(DUZ)=""
- . S RECIPS("G.LMI")=""
- . D EMAIL("LR*5.2*343 -- 69.9 DC Fields","BODY",.RECIPS)
- . K BODY
- . D MSGADD("*** File #69.9 field(s) set to YES ***")
- ;
- D ALERT("LR*5.2*343 Installation has started")
- D MSGADD("Sent install started alert to mail group G.LMI")
- ;
- ; Disable Protocols and set action event to quit
- D MSGADD("Setting DISABLE and ACTION fields for Protocols")
- S IEN=$$FIND1^DIC(101,,"XO","LR7O MOVEMENT EVENT","B",,"ERR")
- I IEN D UPDTPROT(IEN)
- I 'IEN D MSGADD("*** Did not find LR7O MOVEMENT EVENT PROTOCOL ***")
- S IEN=$$FIND1^DIC(101,,"XO","LR7O MOVEMENT EVENT TASK","B",,"ERR")
- I IEN D UPDTPROT(IEN)
- I 'IEN D MSGADD("*** Did not find LR7O MOVEMENT EVENT TASK PROTOCOL ***")
- ;
- ; Now hang for X minutes to let all existing triggered
- ; events to clear so we don't cause any "cant return to source"
- ; errors when we overwrite the protocl's routine which would
- ; cause the other chained events not to be processed (the hang is
- ; why the install is tasked and not run in direct mode)
- H 300
- ;
- I 'PREERR D MSGADD("No actions required for pre install")
- D MSGADD("Pre install completed at "_$$HTE^XLFDT($H))
- Q
- ;
- POST ;
- ; KIDS Post Install
- ; Delete data in File #69.9 fields
- ; Remove #69.9 fields from Data Dictionary
- ; Email installation progress message
- N DA,DIK,LRFDA,LRMSG,LRMSG2,POSTERR,RECIPS
- S POSTERR=0
- D MSGADD("Post install started at "_$$HTE^XLFDT($H))
- D MSGADD("File #69.9 field data update started")
- ; delete #69.9 field data
- S LRFDA(1,69.9,"1,",150.3)="@"
- S LRFDA(1,69.9,"1,",150.4)="@"
- S LRFDA(1,69.9,"1,",150.5)="@"
- K MSG
- D FILE^DIE("","LRFDA(1)","LRMSG")
- I $D(LRMSG) D ;
- . K LRMSG2
- . D MSG^DIALOG("ASEM",.LRMSG2,$G(IOM,80),,"LRMSG")
- . S POSTERR=1
- . D MSGADD(.LRMSG2)
- D KILLDD(150.3)
- D KILLDD(150.4)
- D KILLDD(150.5)
- D MSGADD("File #69.9 field data deletion finished")
- D MSGADD("Post install completed"_$S(POSTERR:" with errors",1:"")_" at "_$$HTE^XLFDT($H))
- D MSGADD("Sending install completion alert to mail group G.LMI")
- ; Send alert
- D ALERT("Installation of patch "_$G(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($H)_$S(POSTERR:" with errors",1:""))
- S RECIPS(DUZ)=""
- D EMAIL("INSTALL COMPLETED:"_$G(XPDNM),"^TMP(""LR343"","_$J_",""MSG"")",.RECIPS)
- D CLEAN
- Q
- ;
- ALERT(MSG) ;
- N DA,DIK,XQA,XQAMSG
- S MSG=$G(MSG)
- S XQAMSG=MSG
- S XQA("G.LMI")=""
- D SETUP^XQALERT
- Q
- ;
- EMAIL(SUB,LRTXT,LRADDR) ;
- ; Sends an email message via MailMan using installer's DUZ
- ; SUB <byval> Subject for the message
- ; LRTXT <byval> Closed root local or global array
- ; ie local array TEXT(1) passed as "TEXT"
- ; LRADDR <byref> MailMan compatable array of message recipients
- N XMERR,XMZ,DIFROM
- D SENDMSG^XMXAPI($G(DUZ),$G(SUB),$G(LRTXT),.LRADDR)
- Q $G(XMZ,-1)
- ;
- BLDBODY(STR,ARR) ;
- ; Adds a string to the end of the passed array
- ; Useful for building email message bodies
- ; STR <req> The string to add to the array
- ; ARR <byref> The array. Should be a simple, integer
- ; based subscript array ie X(1), X(2), etc.
- N SUB
- S STR=$G(STR)
- S SUB=+$O(ARR("A"),-1)
- S ARR(SUB+1)=STR
- Q
- ;
- GETVALS(NULL) ;
- ; Returns the values for #69.9 fields 150.3,150.4,150.5
- ; as a string ie 000 or 010 etc (each field is only 1 or 0)
- N NODE,LRDATA,LRERR,VALUES
- S VALUES=""
- D GETS^DIQ(69.9,"1,","150.3;150.4;150.5","I","LRDATA","LRERR")
- I $D(LRDATA(69.9))>9 D ;
- . S NODE="LRDATA(69.9)"
- . F S NODE=$Q(@NODE) Q:NODE="" Q:$QS(NODE,1)'=69.9 S VALUES=VALUES_+@NODE
- Q VALUES
- ;
- UPDTPROT(IEN) ;
- ; Sets the PROTOCOL's (#101) DISABLE field (#2) to DISABLED
- ; and its ENTRY ACTION field (#20) to Q (QUIT)
- N LRFDA,LRMSG
- S IEN=$G(IEN)
- S LRFDA(1,101,IEN_",",2)="DISABLED BY LR*5.2*343"
- S LRFDA(1,101,IEN_",",20)="Q"
- D FILE^DIE("ET","LRFDA(1)","LRMSG")
- Q
- ;
- MSGADD(TXT,LB) ;
- ; Utility to create a message global to save install
- ; messages and send later, usually via mailman. Useful
- ; when an install is tasked. It will print
- ; the messages out as they come in, as well as save them
- ; to the TMP global
- ; Input
- ; TXT <byref or byval>
- ; If $D(TXT)=1 then TXT is saved
- ; If $D(TXT)>9 then step through array and save each node
- ; as separate line.
- ; LB <opt> LineBreak (True then uses MBES -- False uses MES)
- ;
- ; TXT <byref> is used by-ref when passsing in arrays created by
- ; the FileMan MSG^DIALOG output array
- ;
- N NODE,SUB,POS
- S TXT=$G(TXT)
- S LB=$G(LB)
- I LB="" S LB=1
- S LB=+LB
- S SUB=+$O(^TMP("LR343",$J,"MSG","A"),-1)
- I $D(TXT)>9 D ;
- . S NODE="TXT"
- . F S NODE=$Q(@NODE) Q:NODE="" D ;
- . . S ^TMP("LR343",$J,"MSG",SUB+1)=@NODE
- . . S SUB=SUB+1
- . . I $D(XPDENV) I LB D BMES^XPDUTL($$CJ^XLFSTR(@NODE,$G(IOM,80)))
- . . I $D(XPDENV) I 'LB D MES^XPDUTL($$CJ^XLFSTR(@NODE,$G(IOM,80)))
- . . I '$D(XPDENV) W !,$$CJ^XLFSTR(@NODE,$G(IOM,80))
- . ;
- ;
- I $D(TXT)=1 D ;
- . S ^TMP("LR343",$J,"MSG",SUB+1)=TXT
- . I '$D(XPDENV) I LB D BMES^XPDUTL($$CJ^XLFSTR(TXT,$G(IOM,80)))
- . I '$D(XPDENV) I 'LB D MES^XPDUTL($$CJ^XLFSTR(TXT,$G(IOM,80)))
- . I $D(XPDENV) W !,$$CJ^XLFSTR(TXT,$G(IOM,80))
- Q
- ;
- CLEAN ;
- K ^TMP("LR343",$J)
- D CLEAN^DILF
- Q
- ;
- KILLDD(FIELD) ;
- ; Deletes the #69.9 field's DD
- N DIK,DA
- S DIK="^DD(69.9,"
- S DA=FIELD
- S DA(1)=69.9
- D ^DIK
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR343 8992 printed Mar 13, 2025@21:08:14 Page 2
- LR343 ;DALOI/JDB - LR*5.2*343 KIDS ROUTINE
- +1 ;;5.2;LAB SERVICE;**343**;Sep 27, 1994;Build 1
- +2 ;
- +3 ; Send email if #69.9 fields set to Yes
- +4 ; Set LR7O MOVEMENT EVENT protocols DISABLE and ACTION fields
- +5 ; Pause X minutes so any running protocols can clear
- +6 ; KIDS deletes LR7OEVNT routine
- +7 ; KIDS deletes LR7O MOVEMENT EVENT protocols
- +8 ; Delete data from #69.9 fields
- +9 ; Delete #69.9 fields DD
- +10 ;
- +11 ;
- EN ;
- +1 ; Environment Check
- +2 ; Does not prevent loading of the transport global.
- +3 ;
- +4 DO CLEAN
- +5 DO CHECK
- +6 ;
- IF $GET(XPDQUIT)
- Begin DoDot:1
- +7 WRITE !,$$CJ^XLFSTR("Environment check failed",$GET(IOM,80))
- End DoDot:1
- QUIT
- +8 ;
- +9 WRITE !,$$CJ^XLFSTR("Environment is okay",$GET(IOM,80))
- +10 DO ALERT("Installation of patch "_$GET(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($HOROLOG))
- +11 IF '$GET(XPDENV)
- Begin DoDot:1
- +12 DO ALERT("Transport global for patch "_$GET(XPDNM,"Unknown patch")_" loaded on "_$$HTE^XLFDT($HOROLOG))
- +13 DO MSGADD("Sending transport global loaded alert to mail group G.LMI")
- End DoDot:1
- QUIT
- +14 QUIT
- +15 ;
- CHECK ;
- +1 ; Perform environment check
- +2 NEW POP
- +3 ; Is Home device defined
- +4 ; Need Home device so "task install" option is displayed
- +5 SET POP=0
- SET IOP=""
- SET %ZIS=0
- DO ^%ZIS
- +6 IF POP
- Begin DoDot:1
- +7 SET XPDQUIT=2
- +8 WRITE !,$$CJ^XLFSTR("*** Home device is not defined ***",$GET(IOM,80))
- End DoDot:1
- QUIT
- +9 ;
- +10 ; Device Defined
- +11 IF $SELECT('$GET(IOM):1,'$GET(IOSL):1,$GET(U)'="^":1,1:0)
- Begin DoDot:1
- +12 WRITE !,$$CJ^XLFSTR("*** Terminal Device is not defined ***",$GET(IOM,80))
- +13 SET XPDQUIT=2
- End DoDot:1
- QUIT
- +14 ;
- +15 ; DUZ setup
- +16 IF $SELECT('$GET(DUZ):1,$DATA(DUZ)[0:1,$DATA(DUZ(0))[0:1,1:0)
- Begin DoDot:1
- +17 WRITE !,$$CJ^XLFSTR("*** Please log in to set variables ***",$GET(IOM,80))
- +18 SET XPDQUIT=2
- End DoDot:1
- QUIT
- +19 ;
- +20 ; Active User
- +21 IF $PIECE($$ACTIVE^XUSER(DUZ),"^")'=1
- Begin DoDot:1
- +22 WRITE !,$$CJ^XLFSTR("*** You are not a valid user on this system ***",$GET(IOM,80))
- +23 SET XPDQUIT=2
- End DoDot:1
- QUIT
- +24 ;
- +25 ; KIDS default answer to "Disable Protocols...."
- +26 ;;Dont allow disabling options
- SET XPDDIQ("XPZ1")=0
- +27 SET XPDDIQ("XPZ1","B")="NO"
- +28 QUIT
- +29 ;
- PRE ;
- +1 ; KIDS Pre Install
- +2 ; Check that install was tasked
- +3 ; Check if any File #69.9 fields are set to "YES" If so send
- +4 ; notification email.
- +5 ; Disable Lab Protocols (set DISABLED field and set ACTION to Q)
- +6 ; Hang so current processes started by protocols can end
- +7 NEW IEN,ERR,PREERR,RECIPS,BODY,VALS,STR
- +8 SET PREERR=0
- +9 DO MSGADD("Pre install started at "_$$HTE^XLFDT($HOROLOG))
- +10 ;
- +11 ; Was install tasked? Quit if not
- +12 IF '$DATA(ZTQUEUED)
- IF $GET(IO("Q"))=""
- Begin DoDot:1
- +13 SET XPDQUIT=2
- +14 SET XPDABORT=2
- +15 DO MSGADD("*** THIS INSTALLATION MUST BE TASKED ***")
- +16 DO MSGADD("",0)
- +17 DO MSGADD("Refer to the Patch Installation instructions",0)
- +18 DO MSGADD("for details concerning re-running the install.",0)
- +19 DO CLEAN
- End DoDot:1
- QUIT
- +20 ;
- +21 ; check DD field values and send email if any are YES
- +22 SET VALS=$$GETVALS()
- +23 ;
- IF VALS>0
- Begin DoDot:1
- +24 SET STR="File #69.9 LABORATORY SITE has one or more fields that were set to YES."
- +25 DO BLDBODY(STR,.BODY)
- +26 SET STR=" #150.3 CANCEL ON ADMIT set to "_$SELECT($EXTRACT(VALS,1,1):"YES",1:"NO")
- +27 DO BLDBODY(STR,.BODY)
- +28 SET STR=" #150.4 CANCEL ON DISCHARGE set to "_$SELECT($EXTRACT(VALS,2,2):"YES",1:"NO")
- +29 DO BLDBODY(STR,.BODY)
- +30 SET STR=" #150.5 CANCEL ON SPECIALTY set to "_$SELECT($EXTRACT(VALS,3,3):"YES",1:"NO")
- +31 DO BLDBODY(STR,.BODY)
- +32 DO BLDBODY(" ",.BODY)
- +33 SET STR="One or more DC fields of File #69.9 are set to Yes. These fields should have been set to No according to guidelines issued with the release of OR*3*142 and OR*3*141."
- +34 SET STR=STR_" Facilities would be advised to use the functionality provided in file #100.6 (released with OR*3*142) to maintain the ability to auto discontinue laboratory orders upon a patient movement."
- +35 SET STR=STR_" Please check your configurations to ensure that this migration has occurred."
- +36 DO BLDBODY(STR,.BODY)
- +37 SET RECIPS(DUZ)=""
- +38 SET RECIPS("G.LMI")=""
- +39 DO EMAIL("LR*5.2*343 -- 69.9 DC Fields","BODY",.RECIPS)
- +40 KILL BODY
- +41 DO MSGADD("*** File #69.9 field(s) set to YES ***")
- End DoDot:1
- +42 ;
- +43 DO ALERT("LR*5.2*343 Installation has started")
- +44 DO MSGADD("Sent install started alert to mail group G.LMI")
- +45 ;
- +46 ; Disable Protocols and set action event to quit
- +47 DO MSGADD("Setting DISABLE and ACTION fields for Protocols")
- +48 SET IEN=$$FIND1^DIC(101,,"XO","LR7O MOVEMENT EVENT","B",,"ERR")
- +49 IF IEN
- DO UPDTPROT(IEN)
- +50 IF 'IEN
- DO MSGADD("*** Did not find LR7O MOVEMENT EVENT PROTOCOL ***")
- +51 SET IEN=$$FIND1^DIC(101,,"XO","LR7O MOVEMENT EVENT TASK","B",,"ERR")
- +52 IF IEN
- DO UPDTPROT(IEN)
- +53 IF 'IEN
- DO MSGADD("*** Did not find LR7O MOVEMENT EVENT TASK PROTOCOL ***")
- +54 ;
- +55 ; Now hang for X minutes to let all existing triggered
- +56 ; events to clear so we don't cause any "cant return to source"
- +57 ; errors when we overwrite the protocl's routine which would
- +58 ; cause the other chained events not to be processed (the hang is
- +59 ; why the install is tasked and not run in direct mode)
- +60 HANG 300
- +61 ;
- +62 IF 'PREERR
- DO MSGADD("No actions required for pre install")
- +63 DO MSGADD("Pre install completed at "_$$HTE^XLFDT($HOROLOG))
- +64 QUIT
- +65 ;
- POST ;
- +1 ; KIDS Post Install
- +2 ; Delete data in File #69.9 fields
- +3 ; Remove #69.9 fields from Data Dictionary
- +4 ; Email installation progress message
- +5 NEW DA,DIK,LRFDA,LRMSG,LRMSG2,POSTERR,RECIPS
- +6 SET POSTERR=0
- +7 DO MSGADD("Post install started at "_$$HTE^XLFDT($HOROLOG))
- +8 DO MSGADD("File #69.9 field data update started")
- +9 ; delete #69.9 field data
- +10 SET LRFDA(1,69.9,"1,",150.3)="@"
- +11 SET LRFDA(1,69.9,"1,",150.4)="@"
- +12 SET LRFDA(1,69.9,"1,",150.5)="@"
- +13 KILL MSG
- +14 DO FILE^DIE("","LRFDA(1)","LRMSG")
- +15 ;
- IF $DATA(LRMSG)
- Begin DoDot:1
- +16 KILL LRMSG2
- +17 DO MSG^DIALOG("ASEM",.LRMSG2,$GET(IOM,80),,"LRMSG")
- +18 SET POSTERR=1
- +19 DO MSGADD(.LRMSG2)
- End DoDot:1
- +20 DO KILLDD(150.3)
- +21 DO KILLDD(150.4)
- +22 DO KILLDD(150.5)
- +23 DO MSGADD("File #69.9 field data deletion finished")
- +24 DO MSGADD("Post install completed"_$SELECT(POSTERR:" with errors",1:"")_" at "_$$HTE^XLFDT($HOROLOG))
- +25 DO MSGADD("Sending install completion alert to mail group G.LMI")
- +26 ; Send alert
- +27 DO ALERT("Installation of patch "_$GET(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($HOROLOG)_$SELECT(POSTERR:" with errors",1:""))
- +28 SET RECIPS(DUZ)=""
- +29 DO EMAIL("INSTALL COMPLETED:"_$GET(XPDNM),"^TMP(""LR343"","_$JOB_",""MSG"")",.RECIPS)
- +30 DO CLEAN
- +31 QUIT
- +32 ;
- ALERT(MSG) ;
- +1 NEW DA,DIK,XQA,XQAMSG
- +2 SET MSG=$GET(MSG)
- +3 SET XQAMSG=MSG
- +4 SET XQA("G.LMI")=""
- +5 DO SETUP^XQALERT
- +6 QUIT
- +7 ;
- EMAIL(SUB,LRTXT,LRADDR) ;
- +1 ; Sends an email message via MailMan using installer's DUZ
- +2 ; SUB <byval> Subject for the message
- +3 ; LRTXT <byval> Closed root local or global array
- +4 ; ie local array TEXT(1) passed as "TEXT"
- +5 ; LRADDR <byref> MailMan compatable array of message recipients
- +6 NEW XMERR,XMZ,DIFROM
- +7 DO SENDMSG^XMXAPI($GET(DUZ),$GET(SUB),$GET(LRTXT),.LRADDR)
- +8 QUIT $GET(XMZ,-1)
- +9 ;
- BLDBODY(STR,ARR) ;
- +1 ; Adds a string to the end of the passed array
- +2 ; Useful for building email message bodies
- +3 ; STR <req> The string to add to the array
- +4 ; ARR <byref> The array. Should be a simple, integer
- +5 ; based subscript array ie X(1), X(2), etc.
- +6 NEW SUB
- +7 SET STR=$GET(STR)
- +8 SET SUB=+$ORDER(ARR("A"),-1)
- +9 SET ARR(SUB+1)=STR
- +10 QUIT
- +11 ;
- GETVALS(NULL) ;
- +1 ; Returns the values for #69.9 fields 150.3,150.4,150.5
- +2 ; as a string ie 000 or 010 etc (each field is only 1 or 0)
- +3 NEW NODE,LRDATA,LRERR,VALUES
- +4 SET VALUES=""
- +5 DO GETS^DIQ(69.9,"1,","150.3;150.4;150.5","I","LRDATA","LRERR")
- +6 ;
- IF $DATA(LRDATA(69.9))>9
- Begin DoDot:1
- +7 SET NODE="LRDATA(69.9)"
- +8 FOR
- SET NODE=$QUERY(@NODE)
- if NODE=""
- QUIT
- if $QSUBSCRIPT(NODE,1)'=69.9
- QUIT
- SET VALUES=VALUES_+@NODE
- End DoDot:1
- +9 QUIT VALUES
- +10 ;
- UPDTPROT(IEN) ;
- +1 ; Sets the PROTOCOL's (#101) DISABLE field (#2) to DISABLED
- +2 ; and its ENTRY ACTION field (#20) to Q (QUIT)
- +3 NEW LRFDA,LRMSG
- +4 SET IEN=$GET(IEN)
- +5 SET LRFDA(1,101,IEN_",",2)="DISABLED BY LR*5.2*343"
- +6 SET LRFDA(1,101,IEN_",",20)="Q"
- +7 DO FILE^DIE("ET","LRFDA(1)","LRMSG")
- +8 QUIT
- +9 ;
- MSGADD(TXT,LB) ;
- +1 ; Utility to create a message global to save install
- +2 ; messages and send later, usually via mailman. Useful
- +3 ; when an install is tasked. It will print
- +4 ; the messages out as they come in, as well as save them
- +5 ; to the TMP global
- +6 ; Input
- +7 ; TXT <byref or byval>
- +8 ; If $D(TXT)=1 then TXT is saved
- +9 ; If $D(TXT)>9 then step through array and save each node
- +10 ; as separate line.
- +11 ; LB <opt> LineBreak (True then uses MBES -- False uses MES)
- +12 ;
- +13 ; TXT <byref> is used by-ref when passsing in arrays created by
- +14 ; the FileMan MSG^DIALOG output array
- +15 ;
- +16 NEW NODE,SUB,POS
- +17 SET TXT=$GET(TXT)
- +18 SET LB=$GET(LB)
- +19 IF LB=""
- SET LB=1
- +20 SET LB=+LB
- +21 SET SUB=+$ORDER(^TMP("LR343",$JOB,"MSG","A"),-1)
- +22 ;
- IF $DATA(TXT)>9
- Begin DoDot:1
- +23 SET NODE="TXT"
- +24 ;
- FOR
- SET NODE=$QUERY(@NODE)
- if NODE=""
- QUIT
- Begin DoDot:2
- +25 SET ^TMP("LR343",$JOB,"MSG",SUB+1)=@NODE
- +26 SET SUB=SUB+1
- +27 IF $DATA(XPDENV)
- IF LB
- DO BMES^XPDUTL($$CJ^XLFSTR(@NODE,$GET(IOM,80)))
- +28 IF $DATA(XPDENV)
- IF 'LB
- DO MES^XPDUTL($$CJ^XLFSTR(@NODE,$GET(IOM,80)))
- +29 IF '$DATA(XPDENV)
- WRITE !,$$CJ^XLFSTR(@NODE,$GET(IOM,80))
- End DoDot:2
- +30 ;
- End DoDot:1
- +31 ;
- +32 ;
- IF $DATA(TXT)=1
- Begin DoDot:1
- +33 SET ^TMP("LR343",$JOB,"MSG",SUB+1)=TXT
- +34 IF '$DATA(XPDENV)
- IF LB
- DO BMES^XPDUTL($$CJ^XLFSTR(TXT,$GET(IOM,80)))
- +35 IF '$DATA(XPDENV)
- IF 'LB
- DO MES^XPDUTL($$CJ^XLFSTR(TXT,$GET(IOM,80)))
- +36 IF $DATA(XPDENV)
- WRITE !,$$CJ^XLFSTR(TXT,$GET(IOM,80))
- End DoDot:1
- +37 QUIT
- +38 ;
- CLEAN ;
- +1 KILL ^TMP("LR343",$JOB)
- +2 DO CLEAN^DILF
- +3 QUIT
- +4 ;
- KILLDD(FIELD) ;
- +1 ; Deletes the #69.9 field's DD
- +2 NEW DIK,DA
- +3 SET DIK="^DD(69.9,"
- +4 SET DA=FIELD
- +5 SET DA(1)=69.9
- +6 DO ^DIK
- +7 QUIT