PXCAPL1 ;ISL/dee & LEA/Chylton - PCE Device Interface data edits Prob List ;06 Oct 2013 5:46 PM
;;1.0;PCE PATIENT CARE ENCOUNTER;**33,115,130,168,199**;Aug 12, 1996;Build 51
;
; Translates data from the PCE Device Interface into a call to
; update Problem List
;
Q
; PXCAPROB Copy of a Problem node of the PXCA array
; PXCAPRV Pointer to the provider (200)
; PXCAINDX Count of the number of problems for one provider
; PXCAPL The parameter array passed to Problem List
; PXCARES The result back from Problem List
; PXCANUMB Count of the total number of problems
;
PROBLIST ;Problem List
Q:'$D(^AUPNPROB)!($T(UPDATE^GMPLUTL)="")
N PXCAPRV,PXCAINDX,PXCANUMB
S PXCANUMB=0
S PXCAPRV=""
F S PXCAPRV=$O(PXCA("PROBLEM",PXCAPRV)) Q:PXCAPRV'>0 D
. S PXCAINDX=0
. F S PXCAINDX=$O(PXCA("PROBLEM",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
.. S PXCANUMB=PXCANUMB+1
.. Q:$D(PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX))
.. N PXCAPROB,PXCAPL,PXCARES
.. S PXCAPROB=PXCA("PROBLEM",PXCAPRV,PXCAINDX)
.. S PXCAPL("PROBLEM")=$P(PXCAPROB,"^",10)
.. S PXCAPL("NARRATIVE")=$P(PXCAPROB,"^",1)
.. S PXCAPL("PATIENT")=PXCAPAT
.. S PXCAPL("STATUS")=$S($P(PXCAPROB,"^",3)="1":"A",$P(PXCAPROB,"^",3)="0":"I",1:"A")
.. S PXCAPL("PROVIDER")=PXCAPRV
.. S PXCAPL("LOCATION")=PXCAHLOC
.. S PXCAPL("SC")=$P(PXCAPROB,"^",5)
.. S PXCAPL("AO")=$P(PXCAPROB,"^",6)
.. S PXCAPL("IR")=$P(PXCAPROB,"^",7)
.. S PXCAPL("EC")=$P(PXCAPROB,"^",8)
.. ;PX*1*115 Add MST & HNC
.. S PXCAPL("MST")=$P(PXCAPROB,"^",13)
.. S PXCAPL("HNC")=$P(PXCAPROB,"^",14)
.. S PXCAPL("CV")=$P(PXCAPROB,"^",15)
.. S PXCAPL("SHAD")=$P(PXCAPROB,"^",16)
.. S PXCAPL("DIAGNOSIS")=$P(PXCAPROB,"^",9)
.. I +$G(PXCAVSIT)>0 S PXCAPL("DX_DATE_OF_INTEREST")=$$CSDATE^PXDXUTL(PXCAVSIT)
.. S PXCAPL("RESOLVED")=$P(PXCAPROB,"^",4)
.. S PXCAPL("ONSET")=$P(PXCAPROB,"^",2)
.. S PXCAPL("COMMENT")=$P(PXCAPROB,"^",11)
.. S PXCAPL("LEXICON")=$P(PXCAPROB,"^",12)
.. D UPDATE^GMPLUTL(.PXCAPL,.PXCARES)
.. I $G(PXCARES)'>0 D
... I PXCARES(0)'="Duplicate problem" S PXKERROR("PL",PXCANUMB,0,0)="Problem Not Stored = "_$G(PXCARES(0))_" For Provider = "_PXCAPRV_" and index = "_PXCAINDX
... S PXCA("WARNING","PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM Not Stored^"_$G(PXCARES(0))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCAPL1 2309 printed Oct 16, 2024@18:28:17 Page 2
PXCAPL1 ;ISL/dee & LEA/Chylton - PCE Device Interface data edits Prob List ;06 Oct 2013 5:46 PM
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**33,115,130,168,199**;Aug 12, 1996;Build 51
+2 ;
+3 ; Translates data from the PCE Device Interface into a call to
+4 ; update Problem List
+5 ;
+6 QUIT
+7 ; PXCAPROB Copy of a Problem node of the PXCA array
+8 ; PXCAPRV Pointer to the provider (200)
+9 ; PXCAINDX Count of the number of problems for one provider
+10 ; PXCAPL The parameter array passed to Problem List
+11 ; PXCARES The result back from Problem List
+12 ; PXCANUMB Count of the total number of problems
+13 ;
PROBLIST ;Problem List
+1 if '$DATA(^AUPNPROB)!($TEXT(UPDATE^GMPLUTL)="")
QUIT
+2 NEW PXCAPRV,PXCAINDX,PXCANUMB
+3 SET PXCANUMB=0
+4 SET PXCAPRV=""
+5 FOR
SET PXCAPRV=$ORDER(PXCA("PROBLEM",PXCAPRV))
if PXCAPRV'>0
QUIT
Begin DoDot:1
+6 SET PXCAINDX=0
+7 FOR
SET PXCAINDX=$ORDER(PXCA("PROBLEM",PXCAPRV,PXCAINDX))
if PXCAINDX']""
QUIT
Begin DoDot:2
+8 SET PXCANUMB=PXCANUMB+1
+9 if $DATA(PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX))
QUIT
+10 NEW PXCAPROB,PXCAPL,PXCARES
+11 SET PXCAPROB=PXCA("PROBLEM",PXCAPRV,PXCAINDX)
+12 SET PXCAPL("PROBLEM")=$PIECE(PXCAPROB,"^",10)
+13 SET PXCAPL("NARRATIVE")=$PIECE(PXCAPROB,"^",1)
+14 SET PXCAPL("PATIENT")=PXCAPAT
+15 SET PXCAPL("STATUS")=$SELECT($PIECE(PXCAPROB,"^",3)="1":"A",$PIECE(PXCAPROB,"^",3)="0":"I",1:"A")
+16 SET PXCAPL("PROVIDER")=PXCAPRV
+17 SET PXCAPL("LOCATION")=PXCAHLOC
+18 SET PXCAPL("SC")=$PIECE(PXCAPROB,"^",5)
+19 SET PXCAPL("AO")=$PIECE(PXCAPROB,"^",6)
+20 SET PXCAPL("IR")=$PIECE(PXCAPROB,"^",7)
+21 SET PXCAPL("EC")=$PIECE(PXCAPROB,"^",8)
+22 ;PX*1*115 Add MST & HNC
+23 SET PXCAPL("MST")=$PIECE(PXCAPROB,"^",13)
+24 SET PXCAPL("HNC")=$PIECE(PXCAPROB,"^",14)
+25 SET PXCAPL("CV")=$PIECE(PXCAPROB,"^",15)
+26 SET PXCAPL("SHAD")=$PIECE(PXCAPROB,"^",16)
+27 SET PXCAPL("DIAGNOSIS")=$PIECE(PXCAPROB,"^",9)
+28 IF +$GET(PXCAVSIT)>0
SET PXCAPL("DX_DATE_OF_INTEREST")=$$CSDATE^PXDXUTL(PXCAVSIT)
+29 SET PXCAPL("RESOLVED")=$PIECE(PXCAPROB,"^",4)
+30 SET PXCAPL("ONSET")=$PIECE(PXCAPROB,"^",2)
+31 SET PXCAPL("COMMENT")=$PIECE(PXCAPROB,"^",11)
+32 SET PXCAPL("LEXICON")=$PIECE(PXCAPROB,"^",12)
+33 DO UPDATE^GMPLUTL(.PXCAPL,.PXCARES)
+34 IF $GET(PXCARES)'>0
Begin DoDot:3
+35 IF PXCARES(0)'="Duplicate problem"
SET PXKERROR("PL",PXCANUMB,0,0)="Problem Not Stored = "_$GET(PXCARES(0))_" For Provider = "_PXCAPRV_" and index = "_PXCAINDX
+36 SET PXCA("WARNING","PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM Not Stored^"_$GET(PXCARES(0))
End DoDot:3
End DoDot:2
End DoDot:1
+37 QUIT
+38 ;
