PXRMNOTE ;SLC/AGP - Clincial Reminders tiu note protocol ;05/16/2022
 ;;2.0;CLINICAL REMINDERS;**78**;Feb 4, 2005;Build 10
 ;
EN ;
 N ACTION,NODE,PXRMDOCINFO
 N $ETRAP,$ESTACK
 S $ETRAP="G UNEXPERR^PXRMNOTE"
 S ACTION=$G(^TMP("TIUDOCACT",$J,"ACTION"))
 I ACTION="DELETE"!(ACTION="RETRACT") D
 .S PXRMDOCINFO("OLD","DFN")=$G(^TMP("TIUDOCACT",$J,"PATIENT"))
 .S PXRMDOCINFO("OLD","VISIT")=$G(^TMP("TIUDOCACT",$J,"VISIT"))
 .S NODE=$G(^TMP("TIUDOCACT",$J,"DOCUMENT"))
 .S PXRMDOCINFO("OLD","NOTE IEN")=$P(NODE,U)
 .S PXRMDOCINFO("OLD","NOTE NAME")=$P(NODE,U,2)
 I ACTION="REASSIGN" D
 .S PXRMDOCINFO("OLD","DFN")=$G(^TMP("TIUDOCACT",$J,"PATIENT","OLD"))
 .S PXRMDOCINFO("OLD","VISIT")=$G(^TMP("TIUDOCACT",$J,"VISIT","OLD"))
 .S NODE=$G(^TMP("TIUDOCACT",$J,"DOCUMENT","OLD"))
 .S PXRMDOCINFO("OLD","NOTE IEN")=$P(NODE,U)
 .S PXRMDOCINFO("OLD","NOTE NAME")=$P(NODE,U,2)
 .S PXRMDOCINFO("NEW","DFN")=$G(^TMP("TIUDOCACT",$J,"PATIENT","NEW"))
 .S PXRMDOCINFO("NEW","VISIT")=$G(^TMP("TIUDOCACT",$J,"VISIT","NEW"))
 .S NODE=$G(^TMP("TIUDOCACT",$J,"DOCUMENT","NEW"))
 .S PXRMDOCINFO("NEW","NOTE IEN")=$P(NODE,U)
 .S PXRMDOCINFO("NEW","NOTE NAME")=$P(NODE,U,2)
 S PXRMDOCINFO("ACTION")=ACTION
 D NOTEACT^PXRMDG(.PXRMDOCINFO)
 Q
 ;
UNEXPERR ;
 N %ZT,%ZTERROR
 S %ZT($NA(^TMP("TIUDOCACT",$J)))=""
 D ^%ZTER ;file error
 S $ECODE=""
 Q
 ;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMNOTE   1360     printed  Sep 23, 2025@19:22:47                                                                                                                                                                                                    Page 2
PXRMNOTE  ;SLC/AGP - Clincial Reminders tiu note protocol ;05/16/2022
 +1       ;;2.0;CLINICAL REMINDERS;**78**;Feb 4, 2005;Build 10
 +2       ;
EN        ;
 +1        NEW ACTION,NODE,PXRMDOCINFO
 +2        NEW $ETRAP,$ESTACK
 +3        SET $ETRAP="G UNEXPERR^PXRMNOTE"
 +4        SET ACTION=$GET(^TMP("TIUDOCACT",$JOB,"ACTION"))
 +5        IF ACTION="DELETE"!(ACTION="RETRACT")
               Begin DoDot:1
 +6                SET PXRMDOCINFO("OLD","DFN")=$GET(^TMP("TIUDOCACT",$JOB,"PATIENT"))
 +7                SET PXRMDOCINFO("OLD","VISIT")=$GET(^TMP("TIUDOCACT",$JOB,"VISIT"))
 +8                SET NODE=$GET(^TMP("TIUDOCACT",$JOB,"DOCUMENT"))
 +9                SET PXRMDOCINFO("OLD","NOTE IEN")=$PIECE(NODE,U)
 +10               SET PXRMDOCINFO("OLD","NOTE NAME")=$PIECE(NODE,U,2)
               End DoDot:1
 +11       IF ACTION="REASSIGN"
               Begin DoDot:1
 +12               SET PXRMDOCINFO("OLD","DFN")=$GET(^TMP("TIUDOCACT",$JOB,"PATIENT","OLD"))
 +13               SET PXRMDOCINFO("OLD","VISIT")=$GET(^TMP("TIUDOCACT",$JOB,"VISIT","OLD"))
 +14               SET NODE=$GET(^TMP("TIUDOCACT",$JOB,"DOCUMENT","OLD"))
 +15               SET PXRMDOCINFO("OLD","NOTE IEN")=$PIECE(NODE,U)
 +16               SET PXRMDOCINFO("OLD","NOTE NAME")=$PIECE(NODE,U,2)
 +17               SET PXRMDOCINFO("NEW","DFN")=$GET(^TMP("TIUDOCACT",$JOB,"PATIENT","NEW"))
 +18               SET PXRMDOCINFO("NEW","VISIT")=$GET(^TMP("TIUDOCACT",$JOB,"VISIT","NEW"))
 +19               SET NODE=$GET(^TMP("TIUDOCACT",$JOB,"DOCUMENT","NEW"))
 +20               SET PXRMDOCINFO("NEW","NOTE IEN")=$PIECE(NODE,U)
 +21               SET PXRMDOCINFO("NEW","NOTE NAME")=$PIECE(NODE,U,2)
               End DoDot:1
 +22       SET PXRMDOCINFO("ACTION")=ACTION
 +23       DO NOTEACT^PXRMDG(.PXRMDOCINFO)
 +24       QUIT 
 +25      ;
UNEXPERR  ;
 +1        NEW %ZT,%ZTERROR
 +2        SET %ZT($NAME(^TMP("TIUDOCACT",$JOB)))=""
 +3       ;file error
           DO ^%ZTER
 +4        SET $ECODE=""
 +5        QUIT 
 +6       ;