PXCAPL1.m

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 ---PXCAPL1   2309     printed  Apr 09, 2024@21:30:48                                                                                                                                                                                                     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      ;