HLUOPT2.m

HLUOPT2 ;CIOFO-O/LJA - Purging Entries in file #772 and #773 ;12/13/02 14:03 [ 12/23/2003  3:51 PM ]

 ;;1.6;HEALTH LEVEL SEVEN;**98,1005**;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

HLUOPT2   ;CIOFO-O/LJA - Purging Entries in file #772 and #773 ;12/13/02 14:03 [ 12/23/2003  3:51 PM ]

 +1       ;;1.6;HEALTH LEVEL SEVEN;**98,1005**;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