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 Oct 16, 2024@17:47:38 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 ;
