PXCAPL2.m

PXCAPL2 ;ISL/dee & LEA/Chylton - Translates data from the PCE Device Interface for "DIAGNOSIS/PROBLEM" into a call to update Problem List ;7/19/96

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**33,115**;Aug 12, 1996

 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)

 .. 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("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

 ;

PXCAPL2   ;ISL/dee & LEA/Chylton - Translates data from the PCE Device Interface for "DIAGNOSIS/PROBLEM" into a call to update Problem List ;7/19/96

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**33,115**;Aug 12, 1996

 +2        QUIT 

 +3       ;   PXCADXPL  Copy of a Problem node of the PXCA array

 +4       ;   PXCAPRV   Pointer to the provider (200)

 +5       ;   PXCAINDX  Count of the number of problems for one provider

 +6       ;   PXCAPL    The parameter array passed to Problem List

 +7       ;   PXCARES   The result back from Problem List

 +8       ;   PXCANUMB  Count of the total number of problems

 +9       ;

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                       SET PXCAPL("LEXICON")=$PIECE(PXCADXPL,"^",3)

 +21                       SET PXCAPL("PROBLEM")=$PIECE(PXCADXPL,"^",4)

 +22                       SET PXCAPL("STATUS")=$PIECE(PXCADXPL,"^",6)

 +23                       SET PXCAPL("ONSET")=$PIECE(PXCADXPL,"^",7)

 +24                       SET PXCAPL("RESOLVED")=$PIECE(PXCADXPL,"^",8)

 +25                       SET PXCAPL("SC")=$PIECE(PXCADXPL,"^",9)

 +26                       SET PXCAPL("AO")=$PIECE(PXCADXPL,"^",10)

 +27                       SET PXCAPL("IR")=$PIECE(PXCADXPL,"^",11)

 +28                       SET PXCAPL("EC")=$PIECE(PXCADXPL,"^",12)

 +29      ;Add MST & HNC

 +30                       SET PXCAPL("MST")=$PIECE(PXCADXPL,"^",15)

 +31                       SET PXCAPL("HNC")=$PIECE(PXCADXPL,"^",16)

 +32                       SET PXCAPL("NARRATIVE")=$PIECE(PXCADXPL,"^",13)

 +33      ;Only if new problem

                           IF 'PXCAPL("PROBLEM")

                               SET PXCAPL("RECORDED")=$PIECE($PIECE(PXCA("ENCOUNTER"),"^"),".")

 +34                       DO UPDATE^GMPLUTL(.PXCAPL,.PXCARES)

 +35                       IF $GET(PXCARES)'>0

                               Begin DoDot:3

 +36                               IF PXCARES(0)'="Duplicate problem"

                                       SET PXKERROR("PL",PXCANUMB,0,0)="Problem Not Stored = "_$GET(PXCARES(0))_"  For Provider = "_PXCAPRV_"  and index = "_PXCAINDX

 +37                               SET PXCA("WARNING","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM Not Stored^"_$GET(PXCARES(0))

                               End DoDot:3

 +38                      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

 +39       QUIT 

 +40      ;