PXKFCPT1 ;ISL/JVS - PROCEDURES Routine #2 ;2/11/04 4:18pm
 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,73,124**;Aug 12, 1996
 ;
 ;
IMM ;
 N PXKSEQ1
 I PXKFGAD=1 D IMMADD
 I PXKFGDE=1 D IMMDEL
 Q
IMMADD ;
 S PXKKK=""
 S PXKSEQ1=PXKSEQ+PXKXX
 S PXKCPT=$P($P(PXKPXD(PXKX),"^",2),";")
POVNAR ;
 K ^UTILITY("DIQ1",$J)
 S DIC=81,DA=PXKCPT,DR=2 D EN^DIQ1
 S PXKCPTN=$G(^UTILITY("DIQ1",$J,81,DA,2))
 K ^UTILITY("DIQ1",$J),DIC,DA,DR D
 .Q:PXKCPTN=""  I $D(^AUTNPOV("B",PXKCPTN)) S PXKCPTN=$O(^AUTNPOV("B",PXKCPTN,0))
 ;
QUANTIT S PXKQUN=1,PXSTOP=0
 S PXXX=0
 F  S PXXX=$O(^AUPNVCPT("AD",PXKAV(0,3),PXXX)) Q:PXXX=""  D  Q:$G(PXSTOP)
 .I +$P(^AUPNVCPT(PXXX,0),"^")=PXKCPT D
 ..S PXKQUN=($P(^AUPNVCPT(PXXX,0),"^",16)+1)
 ..S PXSTOP=1
 ..S PXKKK=PXXX
 ..S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"BEFORE")=$G(^AUPNVCPT(PXXX,0))
 K PXSTOP
CATEGOR ;
 N PXKSEQ2
 S PXKCPTT(1)=$P(PXKCPT,"^",1)
 K ^UTILITY("DIQ1",$J)
 S DIC=81,DA=PXKCPTT(1),DR=3 D EN^DIQ1
 Q:$G(^UTILITY("DIQ1",$J,81,DA,3))=""
 S PXKCPTT(4.1)=$G(^UTILITY("DIQ1",$J,81,DA,3))
 S PXKCPTT(5)=$E(PXKCPTT(4.1),1,30)
 S PXKCPTT(6)=$O(^AUTNPOV("B",PXKCPTT(5),0))
 S PXKPCA=$S(PXKCPTT(6)="":PXKCPTT(5),PXKCPTT(6)'="":PXKCPTT(6),1:"")
 K PXKCPTT,^UTILITY("DIQ1",$J),DIC,DR,DA
 ;PX*1*124
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"AFTER")=$G(PXKCPT)_"^"_$G(PXKAV(0,2))_"^"_$G(PXKAV(0,3))_"^"_$G(PXKCPTN)_"^"_$G(PXKAV(0,8))_"^^^^"
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"AFTER")=^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"AFTER")_$G(PXKAV(0,9))_"^"_$G(PXKAV(0,10))_"^"_$G(PXKAV(0,11))_"^"_$G(PXKAV(0,12))_"^"_$G(PXKAV(0,13))_"^"_$G(PXKAV(0,14))_"^"_$G(PXKAV(0,15))_"^"_$G(PXKQUN)
 S PXKSEQ2=0
 F  S PXKSEQ2=$O(PXKAFT(1,PXKSEQ2)) Q:'PXKSEQ2  D
 .S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,1,PXKSEQ2,"AFTER")=PXKAFT(1,PXKSEQ2)
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,12,"AFTER")=$G(PXKAFT(12))
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,802,"AFTER")=$G(PXKCA)
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,812,"AFTER")=$G(PXKAFT(812))
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,"IEN")=PXKKK
 K PXKQUN,PXKCPTN,PXKCA,PXXX,PXKKK
 Q
IMMDEL ;Retrieve all CPT information for VISIT from V CPT file
 S PXKSEQ1=PXKSEQ+PXKXX
 S (XPFG,XP)=0 F  Q:XPFG  S XP=$O(^AUPNVCPT("AD",PXKVST,XP)) Q:XP=""  D
 .I $P(^AUPNVCPT(XP,0),"^",1)=$P($P(PXKPXD(PXKX),"^",2),";") D  S XPFG=1
 ..I $P($G(^AUPNVCPT(XP,0)),"^",16)=1 D IMMDEL1
 ..I $D(XP),$P($G(^AUPNVCPT(XP,0)),"^",16)>1 D IMMDEL2
 Q
IMMDEL1 ;
 N PXKSEQ2,PXKMOD
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"BEFORE")=$G(^AUPNVCPT(XP,0))
 S PXKSEQ2=0
 F  S PXKSEQ2=$O(^AUPNVCPT(XP,1,PXKSEQ2)) Q:'PXKSEQ2  D
 .S PXKMOD=^AUPNVCPT(XP,1,PXKSEQ2,0)
 .S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,1,PXKSEQ2,"BEFORE")=PXKMOD
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,12,"BEFORE")=$G(^AUPNVCPT(XP,12))
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,802,"BEFORE")=$G(^AUPNVCPT(XP,802))
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,812,"BEFORE")=$G(^AUPNVCPT(XP,812))
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,"IEN")=XP
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"AFTER")="@"
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,12,"AFTER")=""
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,802,"AFTER")=""
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,812,"AFTER")=""
 K XPFG,XP
 Q
IMMDEL2 ;
 N PXKSEQ2,PXKMOD
 S PXTEMP=$P($G(^AUPNVCPT(XP,0)),"^",16)
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"BEFORE")=$G(^AUPNVCPT(XP,0))
 S PXKSEQ2=0
 F  S PXKSEQ2=$O(^AUPNVCPT(XP,1,PXKSEQ2)) Q:'PXKSEQ2  D
 .S PXKMOD=^AUPNVCPT(XP,1,PXKSEQ2,0)
 .S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,1,PXKSEQ2,"BEFORE")=PXKMOD
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,12,"BEFORE")=$G(^AUPNVCPT(XP,12))
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,802,"BEFORE")=$G(^AUPNVCPT(XP,802))
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,812,"BEFORE")=$G(^AUPNVCPT(XP,812))
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,"IEN")=XP
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"AFTER")=$G(^AUPNVCPT(XP,0))
 S PXKSEQ2=0
 F  S PXKSEQ2=$O(^AUPNVCPT(XP,1,PXKSEQ2)) Q:'PXKSEQ2  D
 .S PXKMOD=^AUPNVCPT(XP,1,PXKSEQ2,0)
 .S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,1,PXKSEQ2,"BEFORE")=PXKMOD
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,12,"AFTER")=$G(^AUPNVCPT(XP,12))
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,802,"AFTER")=$G(^AUPNVCPT(XP,802))
 S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,812,"AFTER")=$G(^AUPNVCPT(XP,812))
 S $P(^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"AFTER"),"^",16)=((PXTEMP)-(1))
 K XPFG,XP,PXTEMP
 Q
SK ;--START OF SKIN TEST
 D IMM
 Q