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

PXCAPL2.m

Go to the documentation of this file.
  1. PXCAPL2 ;ISL/dee & LEA/Chylton - PCE Device Interface data edits Prob List ;06 Oct 2013 5:54 PM
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**33,115,130,168,199**;Aug 12, 1996;Build 51
  1. ;
  1. ; Translates data from the PCE Device Interface for "DIAGNOSIS/PROBLEM"
  1. ; into a call to update Problem List
  1. ;
  1. Q
  1. ; PXCADXPL Copy of a Problem node of the PXCA array
  1. ; PXCAPRV Pointer to the provider (200)
  1. ; PXCAINDX Count of the number of problems for one provider
  1. ; PXCAPL The parameter array passed to Problem List
  1. ; PXCARES The result back from Problem List
  1. ; PXCANUMB Count of the total number of problems
  1. ;
  1. PROBLIST ;Problem List
  1. Q:'$D(^AUPNPROB)!($T(UPDATE^GMPLUTL)="")
  1. N PXCAPRV,PXCAINDX,PXCANUMB
  1. S PXCANUMB=0
  1. S PXCAPRV=""
  1. F S PXCAPRV=$O(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV)) Q:PXCAPRV'>0 D
  1. . S PXCAINDX=0
  1. . F S PXCAINDX=$O(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
  1. .. S PXCANUMB=PXCANUMB+1
  1. .. ;Quit if there is an error in this node
  1. .. Q:$D(PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX))
  1. .. N PXCADXPL,PXCAPL,PXCARES
  1. .. S PXCADXPL=PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX)
  1. .. S PXCAPL("COMMENT")=$P($G(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE")),"^",1)
  1. .. ;Quit if this is not a problem
  1. .. Q:"^^^"[$P(PXCADXPL,"^",5,8)&(PXCAPL("COMMENT")="")
  1. .. S PXCAPL("PATIENT")=PXCAPAT
  1. .. S PXCAPL("PROVIDER")=PXCAPRV
  1. .. S PXCAPL("LOCATION")=PXCAHLOC
  1. .. S PXCAPL("DIAGNOSIS")=$P(PXCADXPL,"^",1)
  1. .. I +$G(PXCAVSIT)>0 S PXCAPL("DX_DATE_OF_INTEREST")=$$CSDATE^PXDXUTL(PXCAVSIT)
  1. .. S PXCAPL("LEXICON")=$P(PXCADXPL,"^",3)
  1. .. S PXCAPL("PROBLEM")=$P(PXCADXPL,"^",4)
  1. .. S PXCAPL("STATUS")=$P(PXCADXPL,"^",6)
  1. .. S PXCAPL("ONSET")=$P(PXCADXPL,"^",7)
  1. .. S PXCAPL("RESOLVED")=$P(PXCADXPL,"^",8)
  1. .. S PXCAPL("SC")=$P(PXCADXPL,"^",9)
  1. .. S PXCAPL("AO")=$P(PXCADXPL,"^",10)
  1. .. S PXCAPL("IR")=$P(PXCADXPL,"^",11)
  1. .. S PXCAPL("EC")=$P(PXCADXPL,"^",12)
  1. .. ;Add MST & HNC
  1. .. S PXCAPL("MST")=$P(PXCADXPL,"^",15)
  1. .. S PXCAPL("HNC")=$P(PXCADXPL,"^",16)
  1. .. S PXCAPL("CV")=$P(PXCADXPL,"^",17)
  1. .. S PXCAPL("SHAD")=$P(PXCADXPL,"^",18)
  1. .. S PXCAPL("NARRATIVE")=$P(PXCADXPL,"^",13)
  1. .. S:'PXCAPL("PROBLEM") PXCAPL("RECORDED")=$P($P(PXCA("ENCOUNTER"),"^"),".") ;Only if new problem
  1. .. D UPDATE^GMPLUTL(.PXCAPL,.PXCARES)
  1. .. I $G(PXCARES)'>0 D
  1. ... I PXCARES(0)'="Duplicate problem" S PXKERROR("PL",PXCANUMB,0,0)="Problem Not Stored = "_$G(PXCARES(0))_" For Provider = "_PXCAPRV_" and index = "_PXCAINDX
  1. ... S PXCA("WARNING","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM Not Stored^"_$G(PXCARES(0))
  1. .. E I $D(^TMP("PXK",$J,"POV",PXCADNUM(PXCAPRV,PXCAINDX),0,"AFTER"))#2 S $P(^("AFTER"),"^",16)=PXCARES
  1. Q
  1. ;