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

PXKFSK1.m

Go to the documentation of this file.
PXKFSK1 ;ISL/JVS - SKIN TESTS 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,"SK",PXKSEQ1,0,"AFTER")=$P($P(PXKPXD(PXKX),"^",2),";")_"^"_$G(PXKAV(0,2))_"^"_$G(PXKAV(0,3))
 S ^TMP("PXKSAVE",$J,"SK",PXKSEQ1,12,"AFTER")=$G(PXKAFT(12))
 S ^TMP("PXKSAVE",$J,"SK",PXKSEQ1,812,"AFTER")=$G(PXKAFT(812))
 S ^TMP("PXKSAVE",$J,"SK",PXKSEQ1,"IEN")=""
 Q
CPTDEL ;
 S PXKSEQ1=PXKSEQ+PXKXX
 S (XPFG,XP)=0 F  Q:XPFG  S XP=$O(^AUPNVSK("AD",PXKVST,XP)) Q:XP=""  D
 .I $P(^AUPNVSK(XP,0),"^",1)=$P($P(PXKPXD(PXKX),"^",2),";") D
 ..S ^TMP("PXKSAVE",$J,"SK",PXKSEQ1,0,"BEFORE")=$G(^AUPNVSK(XP,0))
 ..S ^TMP("PXKSAVE",$J,"SK",PXKSEQ1,12,"BEFORE")=$G(^AUPNVSK(XP,12))
 ..S ^TMP("PXKSAVE",$J,"SK",PXKSEQ1,812,"BEFORE")=$G(^AUPNVSK(XP,812))
 ..S ^TMP("PXKSAVE",$J,"SK",PXKSEQ1,"IEN")=XP
 ..S XPFG=1
 I '$G(XPFG) Q
 S ^TMP("PXKSAVE",$J,"SK",PXKSEQ1,0,"AFTER")="@"
 S ^TMP("PXKSAVE",$J,"SK",PXKSEQ1,12,"AFTER")=""
 S ^TMP("PXKSAVE",$J,"SK",PXKSEQ1,812,"AFTER")=""
 K XPFG,XP
 Q