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