PXUAXTMP.m

PXUAXTMP ;ISA/KWP - PCE XTMP UTILITY;3/29/1999

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**67**;AUG 12, 1996

 ;

CREATE(PXXTMP,PXXTMP2,PXPRGNO,PXDESC,PXDATA) ;

 ;+ PXXTMP -unique subscript for XTMP

 ;+ PXXTMP2 -secondary subscript

 ;+ PXPRGNO -number of days to increment from today for purge

 ;+ PXDESC -description of XTMP

 ;+ PXDATA -for secondary entry

 ;+ returns -0 failed

 ;+  1 successful

 N PXTMP S PXXTMP=$G(PXXTMP,"PXXTMP")

 I $E(PXXTMP,1,2)'="PX" Q 0

 S PXPRGNO=$G(PXPRGNO,365)

 I '$D(^XTMP(PXXTMP)) D

 .N PXPURGE,PXCREATE S PXTMP="^XTMP("_""""_PXXTMP_""""_",0)"

 .L +@PXTMP:300

 .S PXCREATE=$$DT^XLFDT

 .S PXPURGE=$$HTFM^XLFDT($H+PXPRGNO)

 .S @PXTMP=PXCREATE_"^"_PXPURGE_"^"_PXDESC

 .L -@PXTMP

 I '$G(PXXTMP2) Q 1

 S PXTMP="^XTMP("_""""_PXXTMP_""""_","_""""_PXXTMP2_""""_")"

 L +@PXTMP:300

 S @PXTMP=$G(PXDATA)

 L -@PXTMP

 Q 1

DELETE(PXXTMP,PXXTMP2) ;

 N PXTMP

 S PXTMP="^XTMP("_""""_PXXTMP_""""_")"

 I $G(PXXTMP2)'="" G SKIP

 L +@PXTMP:300

 K @PXTMP

 L -@PXTMP

 Q

SKIP S PXTMP="^XTMP("_""""_PXXTMP_""""_","_""""_PXXTMP2_""""_")"

 L +@PXTMP:300

 K @PXTMP

 L -@PXTMP

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXUAXTMP   1113     printed  Apr 09, 2024@21:29:32                                                                                                                                                                                                    Page 2

PXUAXTMP  ;ISA/KWP - PCE XTMP UTILITY;3/29/1999

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**67**;AUG 12, 1996

 +2       ;

CREATE(PXXTMP,PXXTMP2,PXPRGNO,PXDESC,PXDATA) ;

 +1       ;+ PXXTMP -unique subscript for XTMP

 +2       ;+ PXXTMP2 -secondary subscript

 +3       ;+ PXPRGNO -number of days to increment from today for purge

 +4       ;+ PXDESC -description of XTMP

 +5       ;+ PXDATA -for secondary entry

 +6       ;+ returns -0 failed

 +7       ;+  1 successful

 +8        NEW PXTMP

           SET PXXTMP=$GET(PXXTMP,"PXXTMP")

 +9        IF $EXTRACT(PXXTMP,1,2)'="PX"

               QUIT 0

 +10       SET PXPRGNO=$GET(PXPRGNO,365)

 +11       IF '$DATA(^XTMP(PXXTMP))

               Begin DoDot:1

 +12               NEW PXPURGE,PXCREATE

                   SET PXTMP="^XTMP("_""""_PXXTMP_""""_",0)"

 +13               LOCK +@PXTMP:300

 +14               SET PXCREATE=$$DT^XLFDT

 +15               SET PXPURGE=$$HTFM^XLFDT($HOROLOG+PXPRGNO)

 +16               SET @PXTMP=PXCREATE_"^"_PXPURGE_"^"_PXDESC

 +17               LOCK -@PXTMP

               End DoDot:1

 +18       IF '$GET(PXXTMP2)

               QUIT 1

 +19       SET PXTMP="^XTMP("_""""_PXXTMP_""""_","_""""_PXXTMP2_""""_")"

 +20       LOCK +@PXTMP:300

 +21       SET @PXTMP=$GET(PXDATA)

 +22       LOCK -@PXTMP

 +23       QUIT 1

DELETE(PXXTMP,PXXTMP2) ;

 +1        NEW PXTMP

 +2        SET PXTMP="^XTMP("_""""_PXXTMP_""""_")"

 +3        IF $GET(PXXTMP2)'=""

               GOTO SKIP

 +4        LOCK +@PXTMP:300

 +5        KILL @PXTMP

 +6        LOCK -@PXTMP

 +7        QUIT 

SKIP       SET PXTMP="^XTMP("_""""_PXXTMP_""""_","_""""_PXXTMP2_""""_")"

 +1        LOCK +@PXTMP:300

 +2        KILL @PXTMP

 +3        LOCK -@PXTMP

 +4        QUIT