PXKFIMM1 ;ISL/JVS - IMMUNIAZTIONS ROUTINE #2 ;11/5/96 14:29
;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996
;
;
CPT ;
N PXKSEQ1
I PXKFGAD=1 D CPTADD
I PXKFGDE=1 D CPTDEL
Q
CPTADD ;
S PXKSEQ1=PXKSEQ+PXKXX
S ^TMP("PXKSAVE",$J,"IMM",PXKSEQ1,0,"AFTER")=$P($P(PXKPXD(PXKX),"^",2),";")_"^"_$G(PXKAV(0,2))_"^"_$G(PXKAV(0,3))
S ^TMP("PXKSAVE",$J,"IMM",PXKSEQ1,12,"AFTER")=$G(PXKAFT(12))
S ^TMP("PXKSAVE",$J,"IMM",PXKSEQ1,812,"AFTER")=$G(PXKAFT(812))
S ^TMP("PXKSAVE",$J,"IMM",PXKSEQ1,"IEN")=""
Q
CPTDEL ;
S PXKSEQ1=PXKSEQ+PXKXX
S (XPFG,XP)=0 F Q:XPFG S XP=$O(^AUPNVIMM("AD",PXKVST,XP)) Q:XP="" D
.I $P(^AUPNVIMM(XP,0),"^",1)=$P($P(PXKPXD(PXKX),"^",2),";") D
..S ^TMP("PXKSAVE",$J,"IMM",PXKSEQ1,0,"BEFORE")=$G(^AUPNVIMM(XP,0))
..S ^TMP("PXKSAVE",$J,"IMM",PXKSEQ1,12,"BEFORE")=$G(^AUPNVIMM(XP,12))
..S ^TMP("PXKSAVE",$J,"IMM",PXKSEQ1,812,"BEFORE")=$G(^AUPNVIMM(XP,812))
..S ^TMP("PXKSAVE",$J,"IMM",PXKSEQ1,"IEN")=XP
..S XPFG=1
I '$G(XPFG) Q
S ^TMP("PXKSAVE",$J,"IMM",PXKSEQ1,0,"AFTER")="@"
S ^TMP("PXKSAVE",$J,"IMM",PXKSEQ1,12,"AFTER")=""
S ^TMP("PXKSAVE",$J,"IMM",PXKSEQ1,812,"AFTER")=""
K XPFG,XP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXKFIMM1 1158 printed Dec 13, 2024@02:29:15 Page 2
PXKFIMM1 ;ISL/JVS - IMMUNIAZTIONS ROUTINE #2 ;11/5/96 14:29
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996
+2 ;
+3 ;
CPT ;
+1 NEW PXKSEQ1
+2 IF PXKFGAD=1
DO CPTADD
+3 IF PXKFGDE=1
DO CPTDEL
+4 QUIT
CPTADD ;
+1 SET PXKSEQ1=PXKSEQ+PXKXX
+2 SET ^TMP("PXKSAVE",$JOB,"IMM",PXKSEQ1,0,"AFTER")=$PIECE($PIECE(PXKPXD(PXKX),"^",2),";")_"^"_$GET(PXKAV(0,2))_"^"_$GET(PXKAV(0,3))
+3 SET ^TMP("PXKSAVE",$JOB,"IMM",PXKSEQ1,12,"AFTER")=$GET(PXKAFT(12))
+4 SET ^TMP("PXKSAVE",$JOB,"IMM",PXKSEQ1,812,"AFTER")=$GET(PXKAFT(812))
+5 SET ^TMP("PXKSAVE",$JOB,"IMM",PXKSEQ1,"IEN")=""
+6 QUIT
CPTDEL ;
+1 SET PXKSEQ1=PXKSEQ+PXKXX
+2 SET (XPFG,XP)=0
FOR
if XPFG
QUIT
SET XP=$ORDER(^AUPNVIMM("AD",PXKVST,XP))
if XP=""
QUIT
Begin DoDot:1
+3 IF $PIECE(^AUPNVIMM(XP,0),"^",1)=$PIECE($PIECE(PXKPXD(PXKX),"^",2),";")
Begin DoDot:2
+4 SET ^TMP("PXKSAVE",$JOB,"IMM",PXKSEQ1,0,"BEFORE")=$GET(^AUPNVIMM(XP,0))
+5 SET ^TMP("PXKSAVE",$JOB,"IMM",PXKSEQ1,12,"BEFORE")=$GET(^AUPNVIMM(XP,12))
+6 SET ^TMP("PXKSAVE",$JOB,"IMM",PXKSEQ1,812,"BEFORE")=$GET(^AUPNVIMM(XP,812))
+7 SET ^TMP("PXKSAVE",$JOB,"IMM",PXKSEQ1,"IEN")=XP
+8 SET XPFG=1
End DoDot:2
End DoDot:1
+9 IF '$GET(XPFG)
QUIT
+10 SET ^TMP("PXKSAVE",$JOB,"IMM",PXKSEQ1,0,"AFTER")="@"
+11 SET ^TMP("PXKSAVE",$JOB,"IMM",PXKSEQ1,12,"AFTER")=""
+12 SET ^TMP("PXKSAVE",$JOB,"IMM",PXKSEQ1,812,"AFTER")=""
+13 KILL XPFG,XP
+14 QUIT
