PX1P204.m

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 ---PX1P204   1317     printed  Apr 23, 2025@18:39:56                                                                                                                                                                                                     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