| 1 | HLUOPT2 ;CIOFO-O/LJA - Purging Entries in file #772 and #773 ;12/13/02 14:03
 | 
|---|
| 2 |  ;;1.6;HEALTH LEVEL SEVEN;**98**;Oct 13, 1995
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 | DELBODY(IEN772,APP,STORE) ; Delete the body of a message.  
 | 
|---|
| 5 |  ; (See patch HL*1.6*98 for complete details.)
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 |  ; (Call here ONLY if the message, and all related ACK messages
 | 
|---|
| 8 |  ; have been successfully completed!)
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 |  N NOLN,NOW,SNO,SUB,X
 | 
|---|
| 11 |  ;
 | 
|---|
| 12 |  ; Has the message body already been deleted?  If so, quit...
 | 
|---|
| 13 |  QUIT:'$D(^HL(772,+$G(IEN772),"IN"))  ;->
 | 
|---|
| 14 |  ;
 | 
|---|
| 15 |  ; Set up variable environment...
 | 
|---|
| 16 |  S APP=$G(APP),STORE=$G(STORE),NOW=$$NOW^XLFDT
 | 
|---|
| 17 |  ;
 | 
|---|
| 18 |  ; Get the number lines and delete data...
 | 
|---|
| 19 |  S NOLN=$O(^HL(772,+IEN772,"IN",":"),-1)
 | 
|---|
| 20 |  KILL ^HL(772,+IEN772,"IN")
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 |  ; Get subscript for XTMP data about to be stored.  Make sub 0 entry prn.
 | 
|---|
| 23 |  S SUB=$$XTMP0($$DT^XLFDT)
 | 
|---|
| 24 |  ;
 | 
|---|
| 25 |  ; Get storage number...
 | 
|---|
| 26 |  S SNO=$O(^XTMP(SUB,":"),-1)+1
 | 
|---|
| 27 |  ;
 | 
|---|
| 28 |  ; Store deletion information...
 | 
|---|
| 29 |  S ^XTMP(SUB,SNO,0)=NOW_U_APP_U_NOLN_U_$G(XQY0)_U_$G(ZTSK)
 | 
|---|
| 30 |  ;
 | 
|---|
| 31 |  ; Quit if user doesn't want @STORE data stored...
 | 
|---|
| 32 |  QUIT:STORE']""  ;->
 | 
|---|
| 33 |  ;
 | 
|---|
| 34 |  ; Store STORE data...
 | 
|---|
| 35 |  KILL X S X="I "_STORE D ^DIM I $D(X) MERGE ^XTMP(SUB,SNO,"S")=@STORE
 | 
|---|
| 36 |  ;
 | 
|---|
| 37 |  QUIT
 | 
|---|
| 38 |  ;
 | 
|---|
| 39 | XTMP0(DATE) ; Return subscript for ^XTMP data...
 | 
|---|
| 40 |  N SUB
 | 
|---|
| 41 |  S SUB="HLUOPT2 "_DATE
 | 
|---|
| 42 |  S:'$D(^XTMP(SUB,0)) ^XTMP(SUB,0)=$$FMADD^XLFDT(DATE,7)_U_$$NOW^XLFDT_U_"HLUOPT2 Message Body Deletion"
 | 
|---|
| 43 |  QUIT SUB
 | 
|---|
| 44 |  ;
 | 
|---|
| 45 | EOR ; HLUOPT2 - Purging Entries in file #772 and #773
 | 
|---|