- 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 Jan 18, 2025@03:28:37 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 ;