Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXKFCPT1

PXKFCPT1.m

Go to the documentation of this file. 
  1. PXKFCPT1 ;ISL/JVS,SCK - PROCEDURES Routine #2 ;10/20/2071
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,73,124,194,209,215,211**;Aug 12, 1996;Build 454
  1.  ;
  1.  ;
  1. IMM ;
  1.  N PXKSEQ1
  1.  I PXKFGAD=1 D IMMADD
  1.  I PXKFGDE=1 D IMMDEL
  1.  Q
  1. IMMADD ;
  1.  S PXKKK=""
  1.  S PXKSEQ1=PXKSEQ+PXKXX
  1.  S PXKCPT=$P($P(PXKPXD(PXKX),"^",2),";")
  1. POVNAR ;
  1.  N EVENTDT,PXK1
  1.  ;K ^UTILITY("DIQ1",$J) 
  1.  ;S DIC=81,DA=PXKCPT,DR=2 D EN^DIQ1
  1.  ;S PXKCPTN=$G(^UTILITY("DIQ1",$J,81,DA,2))
  1.  ;K ^UTILITY("DIQ1",$J),DIC,DA,DR D
  1.  S EVENTDT=$G(PXKAV(12,0))
  1.  I EVENTDT="" S EVENTDT=$P(^AUPNVSIT(PXKAV(0,3),0),U,1)
  1.  S PXK1=$$CPT^ICPTCOD(PXKCPT,EVENTDT)
  1.  S PXKCPTN=$P(PXK1,U,3) D
  1.  .Q:PXKCPTN=""  I $D(^AUTNPOV("B",PXKCPTN)) S PXKCPTN=$O(^AUTNPOV("B",PXKCPTN,0))
  1.  ;
  1. QUANTIT S PXKQUN=1,PXSTOP=0
  1.  S PXXX=0
  1.  F  S PXXX=$O(^AUPNVCPT("AD",PXKAV(0,3),PXXX)) Q:PXXX=""  D  Q:$G(PXSTOP)
  1.  .I +$P(^AUPNVCPT(PXXX,0),"^")=PXKCPT D
  1.  ..; PX*1*215 - If code already exists, quit; don't increment qty
  1.  ..;S PXKQUN=($P(^AUPNVCPT(PXXX,0),"^",16)+1)
  1.  ..S PXSTOP=1
  1.  ..;S PXKKK=PXXX
  1.  ..;S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"BEFORE")=$G(^AUPNVCPT(PXXX,0))
  1.  I $G(PXSTOP) Q
  1.  K PXSTOP
  1. CATEGOR ;
  1.  N PXKSEQ2,PXK1,PXK2
  1.  S PXKCPTT(1)=$P(PXKCPT,"^",1)
  1.  ;K ^UTILITY("DIQ1",$J)
  1.  ;S DIC=81,DA=PXKCPTT(1),DR=3 D EN^DIQ1
  1.  S PXK1=$P($$CPT^ICPTCOD(PXKCPTT(1)),U,4)
  1.  S PXK2=$$GET1^DIQ(81.1,PXK1,.01)
  1.  Q:PXK2=""
  1.  ;Q:$G(^UTILITY("DIQ1",$J,81,DA,3))=""
  1.  ;S PXKCPTT(4.1)=$G(^UTILITY("DIQ1",$J,81,DA,3))
  1.  S PXKCPTT(4.1)=PXK2
  1.  S PXKCPTT(5)=$E(PXKCPTT(4.1),1,30)
  1.  S PXKCPTT(6)=$O(^AUTNPOV("B",PXKCPTT(5),0))
  1.  S PXKPCA=$S(PXKCPTT(6)="":PXKCPTT(5),PXKCPTT(6)'="":PXKCPTT(6),1:"")
  1.  K PXKCPTT ;,^UTILITY("DIQ1",$J),DIC,DR,DA
  1.  ;PX*1*124
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"AFTER")=$G(PXKCPT)_"^"_$G(PXKAV(0,2))_"^"_$G(PXKAV(0,3))_"^"_$G(PXKCPTN)_"^"_$G(PXKAV(0,8))_"^^^^"
  1.  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)
  1.  S PXKSEQ2=0
  1.  F  S PXKSEQ2=$O(PXKAFT(1,PXKSEQ2)) Q:'PXKSEQ2  D
  1.  .S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,1,PXKSEQ2,"AFTER")=PXKAFT(1,PXKSEQ2)
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,12,"AFTER")=$G(PXKAV(12,1))_"^"_$G(PXKAV(12,2))_"^^"_$G(PXKAV(12,4))
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,802,"AFTER")=$G(PXKCA)
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,812,"AFTER")=$G(PXKAFT(812))
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,"IEN")=PXKKK
  1.  K PXKQUN,PXKCPTN,PXKCA,PXXX,PXKKK
  1.  Q
  1. IMMDEL ;Retrieve all CPT information for VISIT from V CPT file
  1.  S PXKSEQ1=PXKSEQ+PXKXX
  1.  S (XPFG,XP)=0 F  Q:XPFG  S XP=$O(^AUPNVCPT("AD",PXKVST,XP)) Q:XP=""  D
  1.  .I $P(^AUPNVCPT(XP,0),"^",1)=$P($P(PXKPXD(PXKX),"^",2),";") D  S XPFG=1
  1.  ..I $P($G(^AUPNVCPT(XP,0)),"^",16)=1 D IMMDEL1
  1.  ..I $D(XP),$P($G(^AUPNVCPT(XP,0)),"^",16)>1 D IMMDEL2
  1.  Q
  1. IMMDEL1 ;
  1.  N PXKSEQ2,PXKMOD
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"BEFORE")=$G(^AUPNVCPT(XP,0))
  1.  S PXKSEQ2=0
  1.  F  S PXKSEQ2=$O(^AUPNVCPT(XP,1,PXKSEQ2)) Q:'PXKSEQ2  D
  1.  .S PXKMOD=^AUPNVCPT(XP,1,PXKSEQ2,0)
  1.  .S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,1,PXKSEQ2,"BEFORE")=PXKMOD
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,12,"BEFORE")=$G(^AUPNVCPT(XP,12))
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,802,"BEFORE")=$G(^AUPNVCPT(XP,802))
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,812,"BEFORE")=$G(^AUPNVCPT(XP,812))
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,"IEN")=XP
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"AFTER")="@"
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,12,"AFTER")=""
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,802,"AFTER")=""
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,812,"AFTER")=""
  1.  K XPFG,XP
  1.  Q
  1. IMMDEL2 ;
  1.  N PXKSEQ2,PXKMOD
  1.  S PXTEMP=$P($G(^AUPNVCPT(XP,0)),"^",16)
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"BEFORE")=$G(^AUPNVCPT(XP,0))
  1.  S PXKSEQ2=0
  1.  F  S PXKSEQ2=$O(^AUPNVCPT(XP,1,PXKSEQ2)) Q:'PXKSEQ2  D
  1.  .S PXKMOD=^AUPNVCPT(XP,1,PXKSEQ2,0)
  1.  .S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,1,PXKSEQ2,"BEFORE")=PXKMOD
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,12,"BEFORE")=$G(^AUPNVCPT(XP,12))
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,802,"BEFORE")=$G(^AUPNVCPT(XP,802))
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,812,"BEFORE")=$G(^AUPNVCPT(XP,812))
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,"IEN")=XP
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"AFTER")=$G(^AUPNVCPT(XP,0))
  1.  S PXKSEQ2=0
  1.  F  S PXKSEQ2=$O(^AUPNVCPT(XP,1,PXKSEQ2)) Q:'PXKSEQ2  D
  1.  .S PXKMOD=^AUPNVCPT(XP,1,PXKSEQ2,0)
  1.  .S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,1,PXKSEQ2,"BEFORE")=PXKMOD
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,12,"AFTER")=$G(^AUPNVCPT(XP,12))
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,802,"AFTER")=$G(^AUPNVCPT(XP,802))
  1.  S ^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,812,"AFTER")=$G(^AUPNVCPT(XP,812))
  1.  S $P(^TMP("PXKSAVE",$J,"CPT",PXKSEQ1,0,"AFTER"),"^",16)=((PXTEMP)-(1))
  1.  K XPFG,XP,PXTEMP
  1.  Q
  1. SK ;--START OF SKIN TEST
  1.  D IMM
  1.  Q