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 ---[H[J[2J[HPXUAXTMP 1113 printed Dec 13, 2024@02:31:36 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
