|
Last change
on this file since 770 was 613, checked in by George Lilly, 15 years ago |
|
initial load of WorldVistAEHR
|
|
File size:
1.0 KB
|
| Rev | Line | |
|---|
| [613] | 1 | PXUAXTMP ;ISA/KWP - PCE XTMP UTILITY;3/29/1999
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**67**;AUG 12, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | CREATE(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
|
|---|
| 28 | DELETE(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
|
|---|
| 36 | SKIP 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.
