PXCAPL2 ;ISL/dee & LEA/Chylton - PCE Device Interface data edits Prob List ;06 Oct 2013 5:54 PM
;;1.0;PCE PATIENT CARE ENCOUNTER;**33,115,130,168,199**;Aug 12, 1996;Build 51
;
; Translates data from the PCE Device Interface for "DIAGNOSIS/PROBLEM"
; into a call to update Problem List
;
Q
; PXCADXPL 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("DIAGNOSIS/PROBLEM",PXCAPRV)) Q:PXCAPRV'>0 D
. S PXCAINDX=0
. F S PXCAINDX=$O(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
.. S PXCANUMB=PXCANUMB+1
.. ;Quit if there is an error in this node
.. Q:$D(PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX))
.. N PXCADXPL,PXCAPL,PXCARES
.. S PXCADXPL=PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX)
.. S PXCAPL("COMMENT")=$P($G(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE")),"^",1)
.. ;Quit if this is not a problem
.. Q:"^^^"[$P(PXCADXPL,"^",5,8)&(PXCAPL("COMMENT")="")
.. S PXCAPL("PATIENT")=PXCAPAT
.. S PXCAPL("PROVIDER")=PXCAPRV
.. S PXCAPL("LOCATION")=PXCAHLOC
.. S PXCAPL("DIAGNOSIS")=$P(PXCADXPL,"^",1)
.. I +$G(PXCAVSIT)>0 S PXCAPL("DX_DATE_OF_INTEREST")=$$CSDATE^PXDXUTL(PXCAVSIT)
.. S PXCAPL("LEXICON")=$P(PXCADXPL,"^",3)
.. S PXCAPL("PROBLEM")=$P(PXCADXPL,"^",4)
.. S PXCAPL("STATUS")=$P(PXCADXPL,"^",6)
.. S PXCAPL("ONSET")=$P(PXCADXPL,"^",7)
.. S PXCAPL("RESOLVED")=$P(PXCADXPL,"^",8)
.. S PXCAPL("SC")=$P(PXCADXPL,"^",9)
.. S PXCAPL("AO")=$P(PXCADXPL,"^",10)
.. S PXCAPL("IR")=$P(PXCADXPL,"^",11)
.. S PXCAPL("EC")=$P(PXCADXPL,"^",12)
.. ;Add MST & HNC
.. S PXCAPL("MST")=$P(PXCADXPL,"^",15)
.. S PXCAPL("HNC")=$P(PXCADXPL,"^",16)
.. S PXCAPL("CV")=$P(PXCADXPL,"^",17)
.. S PXCAPL("SHAD")=$P(PXCADXPL,"^",18)
.. S PXCAPL("NARRATIVE")=$P(PXCADXPL,"^",13)
.. S:'PXCAPL("PROBLEM") PXCAPL("RECORDED")=$P($P(PXCA("ENCOUNTER"),"^"),".") ;Only if new problem
.. 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","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM Not Stored^"_$G(PXCARES(0))
.. E I $D(^TMP("PXK",$J,"POV",PXCADNUM(PXCAPRV,PXCAINDX),0,"AFTER"))#2 S $P(^("AFTER"),"^",16)=PXCARES
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCAPL2 2719 printed Dec 13, 2024@02:27:36 Page 2
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
+2 ;
+3 ; Translates data from the PCE Device Interface for "DIAGNOSIS/PROBLEM"
+4 ; into a call to update Problem List
+5 ;
+6 QUIT
+7 ; PXCADXPL 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("DIAGNOSIS/PROBLEM",PXCAPRV))
if PXCAPRV'>0
QUIT
Begin DoDot:1
+6 SET PXCAINDX=0
+7 FOR
SET PXCAINDX=$ORDER(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX))
if PXCAINDX']""
QUIT
Begin DoDot:2
+8 SET PXCANUMB=PXCANUMB+1
+9 ;Quit if there is an error in this node
+10 if $DATA(PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX))
QUIT
+11 NEW PXCADXPL,PXCAPL,PXCARES
+12 SET PXCADXPL=PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX)
+13 SET PXCAPL("COMMENT")=$PIECE($GET(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE")),"^",1)
+14 ;Quit if this is not a problem
+15 if "^^^"[$PIECE(PXCADXPL,"^",5,8)&(PXCAPL("COMMENT")="")
QUIT
+16 SET PXCAPL("PATIENT")=PXCAPAT
+17 SET PXCAPL("PROVIDER")=PXCAPRV
+18 SET PXCAPL("LOCATION")=PXCAHLOC
+19 SET PXCAPL("DIAGNOSIS")=$PIECE(PXCADXPL,"^",1)
+20 IF +$GET(PXCAVSIT)>0
SET PXCAPL("DX_DATE_OF_INTEREST")=$$CSDATE^PXDXUTL(PXCAVSIT)
+21 SET PXCAPL("LEXICON")=$PIECE(PXCADXPL,"^",3)
+22 SET PXCAPL("PROBLEM")=$PIECE(PXCADXPL,"^",4)
+23 SET PXCAPL("STATUS")=$PIECE(PXCADXPL,"^",6)
+24 SET PXCAPL("ONSET")=$PIECE(PXCADXPL,"^",7)
+25 SET PXCAPL("RESOLVED")=$PIECE(PXCADXPL,"^",8)
+26 SET PXCAPL("SC")=$PIECE(PXCADXPL,"^",9)
+27 SET PXCAPL("AO")=$PIECE(PXCADXPL,"^",10)
+28 SET PXCAPL("IR")=$PIECE(PXCADXPL,"^",11)
+29 SET PXCAPL("EC")=$PIECE(PXCADXPL,"^",12)
+30 ;Add MST & HNC
+31 SET PXCAPL("MST")=$PIECE(PXCADXPL,"^",15)
+32 SET PXCAPL("HNC")=$PIECE(PXCADXPL,"^",16)
+33 SET PXCAPL("CV")=$PIECE(PXCADXPL,"^",17)
+34 SET PXCAPL("SHAD")=$PIECE(PXCADXPL,"^",18)
+35 SET PXCAPL("NARRATIVE")=$PIECE(PXCADXPL,"^",13)
+36 ;Only if new problem
if 'PXCAPL("PROBLEM")
SET PXCAPL("RECORDED")=$PIECE($PIECE(PXCA("ENCOUNTER"),"^"),".")
+37 DO UPDATE^GMPLUTL(.PXCAPL,.PXCARES)
+38 IF $GET(PXCARES)'>0
Begin DoDot:3
+39 IF PXCARES(0)'="Duplicate problem"
SET PXKERROR("PL",PXCANUMB,0,0)="Problem Not Stored = "_$GET(PXCARES(0))_" For Provider = "_PXCAPRV_" and index = "_PXCAINDX
+40 SET PXCA("WARNING","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM Not Stored^"_$GET(PXCARES(0))
End DoDot:3
+41 IF '$TEST
IF $DATA(^TMP("PXK",$JOB,"POV",PXCADNUM(PXCAPRV,PXCAINDX),0,"AFTER"))#2
SET $PIECE(^("AFTER"),"^",16)=PXCARES
End DoDot:2
End DoDot:1
+42 QUIT
+43 ;
