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

PXCASK.m

Go to the documentation of this file.
  1. PXCASK ;ISL/dee - Validates & Translates data from the PCE Device Interface into PCE's PXK format for Skin Test ;07/30/15 09:15
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**27,124,199,210**;Aug 12, 1996;Build 21
  1. Q
  1. ; Variables
  1. ; PXCASK Copy of a SKIN TEST node of the PXCA array
  1. ; PXCAPRV Pointer to the provider (200)
  1. ; PXCANUMB Count of the number if SKs
  1. ; PXCAINDX Count of the number of SKIN TEST for one provider
  1. ; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"SK",PXCANUMB,0,"AFTER")
  1. ; PXCAPNAR Pointer to the provider narrative (9999999.27)
  1. ;
  1. SK(PXCASK,PXCANUMB,PXCAPRV,PXCAERRS) ;
  1. N PXCAFTER
  1. S PXCAFTER=$P(PXCASK,"^",1)_"^"_PXCAPAT_"^"_PXCAVSIT_"^"
  1. S PXCAFTER=PXCAFTER_$P(PXCASK,"^",3)_"^"
  1. S PXCAFTER=PXCAFTER_$P(PXCASK,"^",2)_"^"
  1. ;PX*1*124
  1. S PXCAFTER=PXCAFTER_$P(PXCASK,"^",4)
  1. S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,"IEN")=""
  1. S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,0,"BEFORE")=""
  1. S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,0,"AFTER")=PXCAFTER
  1. S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,12,"BEFORE")=""
  1. S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,12,"AFTER")=$P(PXCASK,"^",5)_"^^^"_$S(PXCAPRV>0:PXCAPRV,1:"")
  1. S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,80,"BEFORE")=""
  1. S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,80,"AFTER")=$P(PXCASK,"^",6)_"^"_$P(PXCASK,"^",7)_"^"_$P(PXCASK,"^",8)_"^"_$P(PXCASK,"^",9)_"^"_$P(PXCASK,"^",10)_"^"_$P(PXCASK,"^",11)_"^"_$P(PXCASK,"^",12)_"^"_$P(PXCASK,"^",13)
  1. S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,812,"BEFORE")=""
  1. S ^TMP(PXCAGLB,$J,"SK",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
  1. Q
  1. ;
  1. SKINTEST(PXCA,PXCABULD,PXCAERRS) ;Validation routine for SK
  1. Q:'$D(PXCA("SKIN TEST"))
  1. N ICDDATA,ICDPCE,PXCAINDX,PXCAITEM,PXCANUMB,PXCAPRV,PXCASK,PXDXDATE
  1. S PXDXDATE=$S($D(PXCAVSIT)=1:$$CSDATE^PXDXUTL(PXCAVSIT),$D(PXCADT)=1:PXCADT,1:DT)
  1. S PXCAPRV="",PXCANUMB=0
  1. F S PXCAPRV=$O(PXCA("SKIN TEST",PXCAPRV)) Q:PXCAPRV']"" D
  1. . I PXCAPRV>0 D
  1. .. I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","SKIN TEST",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
  1. .. E I PXCABULD!PXCAERRS D ANOTHPRV^PXCAPRV(PXCAPRV)
  1. . S PXCAINDX=""
  1. . F S PXCAINDX=$O(PXCA("SKIN TEST",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
  1. .. S PXCASK=$G(PXCA("SKIN TEST",PXCAPRV,PXCAINDX))
  1. .. S PXCANUMB=PXCANUMB+1
  1. .. I PXCASK="" S PXCA("ERROR","SKIN TEST",PXCAPRV,PXCAINDX,0)="SKIN TEST data missing" Q
  1. .. S PXCAITEM=+$P(PXCASK,"^",1)
  1. .. I $G(^AUTTSK(PXCAITEM,0))="" S PXCA("ERROR","SKIN TEST",PXCAPRV,PXCAINDX,1)="SKIN TEST type not in file 9999999.28^"_PXCAITEM
  1. .. S PXCAITEM=$P(PXCASK,"^",2)
  1. .. I '((PXCAITEM=(PXCAITEM\1)&(PXCAITEM>-1)&(PXCAITEM<41))!(PXCAITEM="")) S PXCA("ERROR","SKIN TEST",PXCAPRV,PXCAINDX,2)="SKIN TEST reaction must be an integer form 0 to 40^"_PXCAITEM
  1. .. S PXCAITEM=$P(PXCASK,"^",3)
  1. .. I '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="N")!(PXCAITEM="D")!(PXCAITEM="O")) S PXCA("ERROR","SKIN TEST",PXCAPRV,PXCAINDX,3)="SKIN TEST results must be P|N|D|O^"_PXCAITEM
  1. .. F ICDPCE=6:1:13 D
  1. ... S PXCAITEM=$P(PXCASK,"^",ICDPCE) I PXCAITEM]"" D
  1. .... S ICDDATA=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
  1. .... I $P(ICDDATA,"^",1)'>0 D
  1. ..... S PXCA("ERROR","SKIN TEST",PXCAPRV,PXCAINDX,ICDPCE)="SKIN TEST Diagnosis # "_(ICDPCE-5)_" not in file 80^"_PXCAITEM
  1. .... E I $P(ICDDATA,"^",10)'=1 D
  1. ..... S PXCA("ERROR","SKIN TEST",PXCAPRV,PXCAINDX,ICDPCE)="SKIN TEST Diagnosis # "_(ICDPCE-5)_" not an ACTIVE ICD Code^"_PXCAITEM
  1. .. I PXCABULD&'$D(PXCA("ERROR","SKIN TEST",PXCAPRV,PXCAINDX))!PXCAERRS D SK(PXCASK,.PXCANUMB,PXCAPRV,PXCAERRS)
  1. Q
  1. ;