PXCAPL1.m

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

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

 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("DIAGNOSIS")=$P(PXCAPROB,"^",9)

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

 ;

PXCAPL1   ;ISL/dee & LEA/Chylton - Translates data from the PCE Device Interface 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       ;   PXCAPROB  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("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("DIAGNOSIS")=$PIECE(PXCAPROB,"^",9)

 +26                       SET PXCAPL("RESOLVED")=$PIECE(PXCAPROB,"^",4)

 +27                       SET PXCAPL("ONSET")=$PIECE(PXCAPROB,"^",2)

 +28                       SET PXCAPL("COMMENT")=$PIECE(PXCAPROB,"^",11)

 +29                       SET PXCAPL("LEXICON")=$PIECE(PXCAPROB,"^",12)

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

 +31                       IF $GET(PXCARES)'>0

                               Begin DoDot:3

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

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

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

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +34       QUIT 

 +35      ;