source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXUAXTMP.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.0 KB
Line 
1PXUAXTMP ;ISA/KWP - PCE XTMP UTILITY;3/29/1999
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**67**;AUG 12, 1996
3 ;
4CREATE(PXXTMP,PXXTMP2,PXPRGNO,PXDESC,PXDATA) ;
5 ;+ PXXTMP -unique subscript for XTMP
6 ;+ PXXTMP2 -secondary subscript
7 ;+ PXPRGNO -number of days to increment from today for purge
8 ;+ PXDESC -description of XTMP
9 ;+ PXDATA -for secondary entry
10 ;+ returns -0 failed
11 ;+ 1 successful
12 N PXTMP S PXXTMP=$G(PXXTMP,"PXXTMP")
13 I $E(PXXTMP,1,2)'="PX" Q 0
14 S PXPRGNO=$G(PXPRGNO,365)
15 I '$D(^XTMP(PXXTMP)) D
16 .N PXPURGE,PXCREATE S PXTMP="^XTMP("_""""_PXXTMP_""""_",0)"
17 .L +@PXTMP:300
18 .S PXCREATE=$$DT^XLFDT
19 .S PXPURGE=$$HTFM^XLFDT($H+PXPRGNO)
20 .S @PXTMP=PXCREATE_"^"_PXPURGE_"^"_PXDESC
21 .L -@PXTMP
22 I '$G(PXXTMP2) Q 1
23 S PXTMP="^XTMP("_""""_PXXTMP_""""_","_""""_PXXTMP2_""""_")"
24 L +@PXTMP:300
25 S @PXTMP=$G(PXDATA)
26 L -@PXTMP
27 Q 1
28DELETE(PXXTMP,PXXTMP2) ;
29 N PXTMP
30 S PXTMP="^XTMP("_""""_PXXTMP_""""_")"
31 I $G(PXXTMP2)'="" G SKIP
32 L +@PXTMP:300
33 K @PXTMP
34 L -@PXTMP
35 Q
36SKIP S PXTMP="^XTMP("_""""_PXXTMP_""""_","_""""_PXXTMP2_""""_")"
37 L +@PXTMP:300
38 K @PXTMP
39 L -@PXTMP
40 Q
Note: See TracBrowser for help on using the repository browser.