- 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 ---[H[J[2J[HPXCAPL1 2309 printed Jan 18, 2025@03:28:36 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 ;