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

HLUTIL4.m

Go to the documentation of this file. 
  1. HLUTIL4 ;OIFO-O/RJH-Don't Purge & Reprocessing for HLLP & MAILMAN  ;09/02/2008  16:54
  1.  ;;1.6;HEALTH LEVEL SEVEN;**142**;Oct 13, 1995;Build 17
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ; Don't purge and reprocessing functions for HLLP and MailMan
  1.  ; messages only
  1.  Q
  1.  ;
  1. NOPURG() ; for HLLP and MailMan messages only
  1.  ; set the DON'T PURGE field to 1 in order to prevent the message
  1.  ; from purging.
  1.  ; at least one of the variables, HLMTIEN and HLMTIENS, must be defined
  1.  ; HLMTIEN- parent message IEN of file #772
  1.  ; HLMTIENS- child message IEN of file #772
  1.  ; return value :  1 for successfully set the field
  1.  ;                -1 for failure
  1.  ;
  1.  N FLAG
  1.  S FLAG=$$SETPFLAG(1)
  1.  Q FLAG
  1.  ;
  1. PURG() ; for HLLP and MailMan messages only
  1.  ; clear the DON'T PURGE field to allow the message to be purged.
  1.  ; at least one of the variables, HLMTIEN and HLMTIENS, must be defined
  1.  ; HLMTIEN- parent message IEN of file #772
  1.  ; HLMTIENS- child message IEN of file #772
  1.  ; return value :  0 for successfully clear the field
  1.  ;                -1 for failure
  1.  ;
  1.  N FLAG
  1.  S FLAG=$$SETPFLAG(0)
  1.  Q FLAG
  1.  ;
  1. SETPFLAG(STATUS) ; for HLLP and MailMan messages only
  1.  ; to set or to clear the DONT PURGE field
  1.  ; at least one of the variables, HLMTIEN and HLMTIENS, must be defined
  1.  ; HLMTIEN- parent message IEN of file #772
  1.  ; HLMTIENS- child message IEN of file #772
  1.  ; input: 1 to set the DONT PURGE field
  1.  ;        0 to clear the DONT PURGE field.
  1.  ; return value: 1 means successfully set the DONT PURGE field
  1.  ;               0 means successfully clear the DONT PURGE field
  1.  ;              -1 means fail to set or to clear the field
  1.  ;
  1.  N FLAG
  1.  S FLAG=""
  1.  I (STATUS'=1),(STATUS'=0) Q -1
  1.  I '$G(HLMTIEN),'$G(HLMTIENS) Q -1
  1.  ;
  1.  ; both HLMTIEN and HLMTIENS are defined
  1.  I $G(HLMTIEN),$G(HLMTIENS) D
  1.  . I '$D(^HL(772,HLMTIEN)) S FLAG=-1 Q
  1.  . I '$D(^HL(772,HLMTIENS)) S FLAG=-1 Q
  1.  . I (HLMTIEN'=$P(^HL(772,HLMTIENS,0),"^",8)) S FLAG=-1 Q
  1.  . L +^HL(772,HLMTIEN):300
  1.  . E  S FLAG=-1 Q
  1.  . L +^HL(772,HLMTIENS):300
  1.  . E  L -^HL(772,HLMTIEN) S FLAG=-1 Q
  1.  . D SETVALUE
  1.  . L -^HL(772,HLMTIENS)
  1.  . L -^HL(772,HLMTIEN)
  1.  . S FLAG=STATUS
  1.  I (FLAG=-1)!(FLAG=STATUS) Q FLAG
  1.  ;
  1.  ; only HLMTIEN(parent message IEN) is defined
  1.  I $G(HLMTIEN) D
  1.  . I '$D(^HL(772,HLMTIEN)) S FLAG=-1 Q
  1.  . I (HLMTIEN'=$P(^HL(772,HLMTIEN,0),"^",8)) S FLAG=-1 Q
  1.  . L +^HL(772,HLMTIEN):300
  1.  . E  S FLAG=-1 Q
  1.  . D SETVALUE
  1.  . L -^HL(772,HLMTIEN)
  1.  . S FLAG=STATUS
  1.  I (FLAG=-1)!(FLAG=STATUS) Q FLAG
  1.  ;
  1.  ; only HLMTIENS(child message IEN) is defined
  1.  I $G(HLMTIENS) D
  1.  . I '$D(^HL(772,HLMTIENS)) S FLAG=-1 Q
  1.  . S HLMTIEN=$P(^HL(772,HLMTIENS,0),"^",8)
  1.  . I 'HLMTIEN S FLAG=-1 Q
  1.  . I '$D(^HL(772,HLMTIEN)) S FLAG=-1 Q
  1.  . I (HLMTIEN'=$P(^HL(772,HLMTIEN,0),"^",8)) S FLAG=-1 Q
  1.  . L +^HL(772,HLMTIEN):300
  1.  . E  S FLAG=-1 Q
  1.  . L +^HL(772,HLMTIENS):300
  1.  . E  L -^HL(772,HLMTIEN) S FLAG=-1 Q
  1.  . D SETVALUE
  1.  . L -^HL(772,HLMTIENS)
  1.  . L -^HL(772,HLMTIEN)
  1.  . S FLAG=STATUS
  1.  Q FLAG
  1.  ;
  1. SETVALUE ; set or clear the DONT PURGE field
  1.  S ^HL(772,HLMTIEN,2)=STATUS
  1.  I $G(HLMTIENS) S ^HL(772,HLMTIENS,2)=STATUS
  1.  Q
  1.  ;
  1. PROC(IEN,RTN) ; reprocessing HLLP or MailMan message
  1.  ; IEN- either the parent message IEN or the child message IEN
  1.  ;  of file #772
  1.  ; RTN- the routine, to be Xecuted for processing the message
  1.  ;
  1.  ; return value:
  1.  ; "0^reprocessing is successful" for success.
  1.  ; "-1^<error text>" for failure.
  1.  ;
  1.  N HLMTIEN,HLMTIENS,HLNEXT,HLNODE,HLQUIT,HLERR,HLRESLT
  1.  N HL,HDR,HLMSA,X,X1
  1.  N HLI,HLTMP,MSAFLAG
  1.  ;
  1.  Q:'$G(IEN) "-1^not a valid IEN"
  1.  I $G(RTN)']"" Q "-1^reprocessing routine is misssing"
  1.  ;
  1.  S HLTMP=$G(^HL(772,IEN,0))
  1.  I HLTMP']"" Q "-1^not a valid entry"
  1.  I $P(HLTMP,"^",4)'="I" Q "-1^not an incoming message"
  1.  ;
  1.  ; get parent message ien
  1.  S HLMTIEN=$P(HLTMP,"^",8)
  1.  ;
  1.  ; if IEN is child, define HLMTIENS as child IEN
  1.  I HLMTIEN,(HLMTIEN'=IEN) S HLMTIENS=IEN
  1.  ;
  1.  ; if IEN is parent, find child ien, HLMTIENS
  1.  I '$G(HLMTIENS) D
  1.  . S HLMTIEN=IEN
  1.  . S HLMTIENS=+$O(^HL(772,"AI",IEN,IEN))
  1.  ;
  1.  S HLMSA=""
  1.  S MSAFLAG=0
  1.  S X=0
  1.  F HLI=1:1:6 S X=$O(^HL(772,HLMTIEN,"IN",X)) Q:(X'>0)!(MSAFLAG)  D
  1.  . S X1=$G(^HL(772,HLMTIEN,"IN",X,0))
  1.  . Q:"FHS,BHS,MSH,MSA"'[$E(X1,1,3)
  1.  . ; If header segment, define HDR for header
  1.  . I '$D(HDR),"FHS,BHS,MSH"[$E(X1,1,3) D  Q
  1.  .. S HDR=X1
  1.  . ; variable HLMSA is used to save the MSA segment data of MSH msg,
  1.  . ; HLMSA is not for saving the MSA segment data of BHS msg
  1.  . ; the MSA segment data of BHS msg will be set in CHK^HLTPCK1
  1.  . I $E(X1,1,3)="MSA",$G(HLMSA)="",$E($G(HDR),1,3)="MSH" D
  1.  .. S HLMSA=X1
  1.  .. S MSAFLAG=1
  1.  ;
  1.  Q:'$D(HDR) "-1^missing message header segment"
  1.  ;
  1.  ;Validate message header
  1.  D CHK^HLTPCK1(HDR,.HL,$S(HLMSA]"":$P(HLMSA,$E(HDR,4),2,4),1:""))
  1.  ;
  1.  I $G(HL)]"" Q "-1^"_HL
  1.  ;
  1.  S HLQUIT=0,HLNODE="",HLNEXT="D HLNEXT^HLCSUTL"
  1.  ;
  1.  I RTN["D " X RTN
  1.  I RTN'["D " D
  1.  . I RTN["^" X "D "_RTN
  1.  . I RTN'["^" X "D ^"_RTN
  1.  ;
  1.  S HLRESLT=0
  1.  S:($D(HLERR)) HLRESLT="9^"_$G(^HL(771.7,9,0))
  1.  ;
  1.  ; update the status of child message
  1.  I $G(HLMTIENS) D
  1.  . D STATUS^HLTF0(HLMTIENS,$S(HLRESLT:4,1:3),$S(HLRESLT:+HLRESLT,1:""),$S($D(HLERR):HLERR,HLRESLT:$P(HLRESLT,"^",2),1:""),,1)
  1.  ;
  1.  ; update the status of parent message
  1.  D STATUS^HLTF0(HLMTIEN,$S(HLRESLT:4,1:3),$S(HLRESLT:+HLRESLT,1:""),$S(HLRESLT:$P(HLRESLT,"^",2),1:""),,1)
  1.  ;
  1.  Q "0^reprocessing is successful"
  1.  ;