PX1P204 ;ALB/LLS - update ENTRY ACTION of protocol PXCE NEW ENCOUNTER
;;1.0;PCE PATIENT CARE ENCOUNTER;**204**;Aug 12, 1996;Build 14
;
Q
;
PROCESS ; Look at all entries in the PATIENT file (#2).
N PXIEN,PXNODE
S PXIEN=$O(^ORD(101,"B","PXCE NEW ENCOUNTER",""))
;
K ^XTMP("PX1P204",$J)
I PXIEN="" S ^XTMP("PX1P204",$J,"OLD")="DID NOT EXIST" G SNDMSG
;
; set up 0 node of ^XTMP to allow the system to purge after 90 days
S (^XTMP("PX1P204",0),^XTMP("PX1P204",$J,0))=$$FMADD^XLFDT(DT,90)_U_DT_U_"Update ENTRY ACTION of protocol PXCE NEW ENCOUNTER"
;
I '$D(^ORD(101,PXIEN,20)) S ^XTMP("PX1P204",$J,"OLD")="DID NOT EXIST" G SNDMSG
S ^XTMP("PX1P204",$J,"OLD")=^ORD(101,PXIEN,20)
S ^ORD(101,PXIEN,20)="S PXCEVIEN="""" D SDSALONE^PXCEPAT D:$G(PXCEPAT)>0 EN^PXCEVFIL(""SIT"")"
S ^XTMP("PX1P204",$J,"NEW")=^ORD(101,PXIEN,20)
SNDMSG ;
D MES^XPDUTL("------------------------------------------------------------------------")
D MES^XPDUTL("The process to update ENTRY ACTION of protocol PXCE NEW ENCOUNTER is complete")
D MES^XPDUTL(" OLD value: ")
D MES^XPDUTL(" "_$G(^XTMP("PX1P204",$J,"OLD")))
D MES^XPDUTL(" NEW value: ")
D MES^XPDUTL(" "_$G(^XTMP("PX1P204",$J,"NEW")))
D MES^XPDUTL("------------------------------------------------------------------------")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPX1P204 1317 printed Nov 22, 2024@17:35:38 Page 2
PX1P204 ;ALB/LLS - update ENTRY ACTION of protocol PXCE NEW ENCOUNTER
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**204**;Aug 12, 1996;Build 14
+2 ;
+3 QUIT
+4 ;
PROCESS ; Look at all entries in the PATIENT file (#2).
+1 NEW PXIEN,PXNODE
+2 SET PXIEN=$ORDER(^ORD(101,"B","PXCE NEW ENCOUNTER",""))
+3 ;
+4 KILL ^XTMP("PX1P204",$JOB)
+5 IF PXIEN=""
SET ^XTMP("PX1P204",$JOB,"OLD")="DID NOT EXIST"
GOTO SNDMSG
+6 ;
+7 ; set up 0 node of ^XTMP to allow the system to purge after 90 days
+8 SET (^XTMP("PX1P204",0),^XTMP("PX1P204",$JOB,0))=$$FMADD^XLFDT(DT,90)_U_DT_U_"Update ENTRY ACTION of protocol PXCE NEW ENCOUNTER"
+9 ;
+10 IF '$DATA(^ORD(101,PXIEN,20))
SET ^XTMP("PX1P204",$JOB,"OLD")="DID NOT EXIST"
GOTO SNDMSG
+11 SET ^XTMP("PX1P204",$JOB,"OLD")=^ORD(101,PXIEN,20)
+12 SET ^ORD(101,PXIEN,20)="S PXCEVIEN="""" D SDSALONE^PXCEPAT D:$G(PXCEPAT)>0 EN^PXCEVFIL(""SIT"")"
+13 SET ^XTMP("PX1P204",$JOB,"NEW")=^ORD(101,PXIEN,20)
SNDMSG ;
+1 DO MES^XPDUTL("------------------------------------------------------------------------")
+2 DO MES^XPDUTL("The process to update ENTRY ACTION of protocol PXCE NEW ENCOUNTER is complete")
+3 DO MES^XPDUTL(" OLD value: ")
+4 DO MES^XPDUTL(" "_$GET(^XTMP("PX1P204",$JOB,"OLD")))
+5 DO MES^XPDUTL(" NEW value: ")
+6 DO MES^XPDUTL(" "_$GET(^XTMP("PX1P204",$JOB,"NEW")))
+7 DO MES^XPDUTL("------------------------------------------------------------------------")
+8 QUIT
