HLUOPTF1.m

HLUOPTF1 ;ALB/CJM-HL7 -Set Logic for the AI x-ref on file 773 ;02/04/2004

 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995

 ;

PXREF(IEN,STATUS) ;sets the AI x-ref on file 773 and the FAST PURGE DT/TM fields in file 772 and 773

 ;Input:  IEN is the ien of record in file 773

 ;        STATUS is the new value of the STATUS field

 ;Output: none

 ;

 Q:'$G(IEN)

 ;

 ;don't set the x-ref if status is  not Successfully Completed 

 Q:($G(STATUS)'=3)

 ;

 N NODE,WHEN,CHILD

 ;

 ;also not if DON'T PURGE field is set

 Q:$P($G(^HLMA(IEN,2)),"^")=1

 ;

 ;also not if this isn't the initial message

 S NODE=$G(^HLMA(IEN,0))

 I $P(NODE,"^",6),$P(NODE,"^",6)'=IEN Q

 ;

 ;This record can be purged via FAST PURGE

 ;determine the dt/tm the record can be purged

 S WHEN=$$NOW^XLFDT

 S WHEN=$$FMADD^XLFDT(WHEN,$$WAIT)

 ;

 ;set the FAST PURGE DT/TM and x-ref, and do the same for file 772 record

 D SET(IEN,WHEN,+NODE)

 ;

 ;All the records in file 773 that point to this record (children) should be purged at the same time

 S CHILD=0

 F  S CHILD=$O(^HLMA("AF",IEN,CHILD)) Q:'CHILD  D:(CHILD'=IEN) SET(CHILD,WHEN,+$G(^HLMA(CHILD,0)))

 Q

 ;

SET(IEN773,WHEN,IEN772) ;sets FAST PURGE DT/TM for and the AI x~ref for both file 772 & 773

 ;Input:

 ;   IEN773 - ien of record to be purged in file 773

 ;   WHEN - date/time to purge

 ;   IEN772 - ien of corresponding record in file 772

 ;

 N OLDWHEN

 ;if the fast purge dt/tm changed, kill the old xref

 S OLDWHEN=$P($G(^HLMA(IEN773,2)),"^",2)

 I $L(OLDWHEN) K ^HLMA("AI",OLDWHEN,773,IEN773)

 ;

 ;set the FAST PURGE DATE

 S $P(^HLMA(IEN773,2),"^",2)=WHEN

 ;

 ;set the AI x-ref

 S ^HLMA("AI",WHEN,773,IEN773)=""

 ;

 ;do the same for the corresponding entry in file 772

 I IEN772,$D(^HL(772,IEN772,0)) D

 .;if the fast purge dt/tm changed, kill the old xref

 .S OLDWHEN=$P($G(^HL(772,IEN772,2)),"^",2)

 .I $L(OLDWHEN) K ^HLMA("AI",OLDWHEN,772,IEN772)

 .;set the FAST PURGE DATE

 .S $P(^HL(772,IEN772,2),"^",2)=WHEN

 .;

 .;set the AI x-ref

 .S ^HLMA("AI",WHEN,772,IEN772)=""

 Q

 ;

WAIT() ;

 ;returns the wait time to purge completed messages from file 869.3

 N IEN

 S IEN=$O(^HLCS(869.3,0))

 Q:'IEN 0

 Q +$G(^HLCS(869.3,IEN,4))

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---HLUOPTF1   2215     printed  Mar 13, 2025@21:05:18                                                                                                                                                                                                    Page 2

HLUOPTF1  ;ALB/CJM-HL7 -Set Logic for the AI x-ref on file 773 ;02/04/2004

 +1       ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995

 +2       ;

PXREF(IEN,STATUS) ;sets the AI x-ref on file 773 and the FAST PURGE DT/TM fields in file 772 and 773

 +1       ;Input:  IEN is the ien of record in file 773

 +2       ;        STATUS is the new value of the STATUS field

 +3       ;Output: none

 +4       ;

 +5        if '$GET(IEN)

               QUIT 

 +6       ;

 +7       ;don't set the x-ref if status is  not Successfully Completed 

 +8        if ($GET(STATUS)'=3)

               QUIT 

 +9       ;

 +10       NEW NODE,WHEN,CHILD

 +11      ;

 +12      ;also not if DON'T PURGE field is set

 +13       if $PIECE($GET(^HLMA(IEN,2)),"^")=1

               QUIT 

 +14      ;

 +15      ;also not if this isn't the initial message

 +16       SET NODE=$GET(^HLMA(IEN,0))

 +17       IF $PIECE(NODE,"^",6)

               IF $PIECE(NODE,"^",6)'=IEN

                   QUIT 

 +18      ;

 +19      ;This record can be purged via FAST PURGE

 +20      ;determine the dt/tm the record can be purged

 +21       SET WHEN=$$NOW^XLFDT

 +22       SET WHEN=$$FMADD^XLFDT(WHEN,$$WAIT)

 +23      ;

 +24      ;set the FAST PURGE DT/TM and x-ref, and do the same for file 772 record

 +25       DO SET(IEN,WHEN,+NODE)

 +26      ;

 +27      ;All the records in file 773 that point to this record (children) should be purged at the same time

 +28       SET CHILD=0

 +29       FOR 

               SET CHILD=$ORDER(^HLMA("AF",IEN,CHILD))

               if 'CHILD

                   QUIT 

               if (CHILD'=IEN)

                   DO SET(CHILD,WHEN,+$GET(^HLMA(CHILD,0)))

 +30       QUIT 

 +31      ;

SET(IEN773,WHEN,IEN772) ;sets FAST PURGE DT/TM for and the AI x~ref for both file 772 & 773

 +1       ;Input:

 +2       ;   IEN773 - ien of record to be purged in file 773

 +3       ;   WHEN - date/time to purge

 +4       ;   IEN772 - ien of corresponding record in file 772

 +5       ;

 +6        NEW OLDWHEN

 +7       ;if the fast purge dt/tm changed, kill the old xref

 +8        SET OLDWHEN=$PIECE($GET(^HLMA(IEN773,2)),"^",2)

 +9        IF $LENGTH(OLDWHEN)

               KILL ^HLMA("AI",OLDWHEN,773,IEN773)

 +10      ;

 +11      ;set the FAST PURGE DATE

 +12       SET $PIECE(^HLMA(IEN773,2),"^",2)=WHEN

 +13      ;

 +14      ;set the AI x-ref

 +15       SET ^HLMA("AI",WHEN,773,IEN773)=""

 +16      ;

 +17      ;do the same for the corresponding entry in file 772

 +18       IF IEN772

               IF $DATA(^HL(772,IEN772,0))

                   Begin DoDot:1

 +19      ;if the fast purge dt/tm changed, kill the old xref

 +20                   SET OLDWHEN=$PIECE($GET(^HL(772,IEN772,2)),"^",2)

 +21                   IF $LENGTH(OLDWHEN)

                           KILL ^HLMA("AI",OLDWHEN,772,IEN772)

 +22      ;set the FAST PURGE DATE

 +23                   SET $PIECE(^HL(772,IEN772,2),"^",2)=WHEN

 +24      ;

 +25      ;set the AI x-ref

 +26                   SET ^HLMA("AI",WHEN,772,IEN772)=""

                   End DoDot:1

 +27       QUIT 

 +28      ;

WAIT()    ;

 +1       ;returns the wait time to purge completed messages from file 869.3

 +2        NEW IEN

 +3        SET IEN=$ORDER(^HLCS(869.3,0))

 +4        if 'IEN

               QUIT 0

 +5        QUIT +$GET(^HLCS(869.3,IEN,4))