- PXCAPL ;ISL/dee & LEA/Chylton,SCK - Validates data from the PCE Device Interface into a call to update Problem List ;6/6/05
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,115,130,168,194,199**;Aug 12, 1996;Build 51
- 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
- ;
- ;
- PROBLEM(PXCA,PXCABULD,PXCAERRS) ;
- Q:'$D(PXCA("PROBLEM"))
- I '$D(^AUPNPROB)!($T(UPDATE^GMPLUTL)="") S PXCA("WARNING","PROBLEM",0,0,0)="Problem List Package is not installed" Q
- N PXCAINDX,PXCAITEM,PXCAITM2,PXCAPROB,PXCAPRV,PXDXDATE
- S PXDXDATE=$S($D(PXCAVSIT)=1:$$CSDATE^PXDXUTL(PXCAVSIT),1:PXCADT)
- S PXCAPRV=""
- F S PXCAPRV=$O(PXCA("PROBLEM",PXCAPRV)) Q:PXCAPRV']"" D
- . I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","PROBLEM",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
- . E I PXCABULD!PXCAERRS D ANOTHPRV^PXCAPRV(PXCAPRV)
- . S PXCAINDX=0
- . F S PXCAINDX=$O(PXCA("PROBLEM",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
- .. S PXCAPROB=$G(PXCA("PROBLEM",PXCAPRV,PXCAINDX))
- .. I PXCAPROB="" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM data missing" Q
- .. S PXCAITEM=$P(PXCAPROB,U,1),PXCAITM2=$L(PXCAITEM)
- .. I PXCAITEM]"",PXCAITM2<2!(PXCAITM2>80) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,1)="Problem Name must be 2-80 Characters^"_PXCAITEM
- .. S PXCAITEM=$P(PXCAPROB,U,2)
- .. I PXCAITEM]"",PXCAITEM>DT!(PXCAITEM<1800000)!($P(+PXCAITEM,".")'=PXCAITEM)!(PXCAITEM>+$P($P(PXCA("ENCOUNTER"),"^"),".")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="Problem Onset Date is bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCAPROB,U,3)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,3)="Problem Active flag bad^"_PXCAITEM
- .. E I PXCAITEM="" S $P(PXCA("PROBLEM",PXCAPRV,PXCAINDX),U,3)=1
- .. S PXCAITEM=$P(PXCAPROB,U,4)
- .. I PXCAITEM]"",PXCAITEM>DT!(PXCAITEM<1800000)!($P(+PXCAITEM,".")'=PXCAITEM)!(PXCAITEM>+$P($P(PXCA("ENCOUNTER"),"^"),".")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="Problem Resolved Date is bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCAPROB,U,5)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,5)="SC flag bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCAPROB,U,6)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,6)="AO flag bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCAPROB,U,7)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="IR flag bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCAPROB,U,8)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,8)="EC flag bad^"_PXCAITEM
- .. ;PX*1*115 - ADD MST & HNC
- .. S PXCAITEM=$P(PXCAPROB,U,13)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,13)="MST flag bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCAPROB,U,14)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,14)="HNC flag bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCAPROB,U,15)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,14)="CV flag bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCAPROB,U,16)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,16)="PROJ 112/SHAD flag bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCAPROB,U,9)
- .. I PXCAITEM>0 D
- ... S PXCADIQ1=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
- ... I $P(PXCADIQ1,U,1)'>0 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="Diagnosis Code pointer results in a '"_$P(PXCADIQ1,U,2)_"' error message.^"_PXCAITEM
- ... E I $P(PXCADIQ1,U,10)'=1 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="Diagnosis Code is INACTIVE^"_PXCAITEM
- .. S PXCAITEM=$P(PXCAPROB,U,10)
- .. I PXCAITEM]"" D
- ... I $G(^AUPNPROB(PXCAITEM,0))="" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,10)="Problem not in file 9000011^"_PXCAITEM
- ... E I PXCAPAT'=$P($G(^AUPNPROB(PXCAITEM,0)),"^",2) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,10)="Problem in file 9000011 is for a different Patient^"_PXCAITEM
- .. E S PXCAITEM=$P(PXCAPROB,U,1) I PXCAITEM']"" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,1)="Problem Name required for a new Problem List entry^"_PXCAITEM
- .. S PXCAITEM=$P(PXCAPROB,U,11),PXCAITM2=$L(PXCAITEM)
- .. I PXCAITM2>60 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,11)="PROBLEM comment must be 1-60 Characters^"_PXCAITEM
- .. ;
- .. ;Clinical Lexicon Term
- .. S PXCAITEM=$P(PXCAPROB,"^",12)
- .. I PXCAITEM]"" D
- ... I $D(^LEX(757.01)) D
- .... I $D(^LEX(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Lexicon Utility term is not in file 757.01^"_PXCAITEM
- .... E S PXCACLEX=PXCAITEM
- ... E I $D(^GMP(757.01)) D
- .... I $D(^GMP(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM
- .... E S PXCACLEX=PXCAITEM
- ... E S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Lexicon Utility is not installed^"_PXCAITEM
- ;
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCAPL 5188 printed Jan 18, 2025@03:28:35 Page 2
- PXCAPL ;ISL/dee & LEA/Chylton,SCK - Validates data from the PCE Device Interface into a call to update Problem List ;6/6/05
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,115,130,168,194,199**;Aug 12, 1996;Build 51
- +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 ;
- +10 ;
- PROBLEM(PXCA,PXCABULD,PXCAERRS) ;
- +1 if '$DATA(PXCA("PROBLEM"))
- QUIT
- +2 IF '$DATA(^AUPNPROB)!($TEXT(UPDATE^GMPLUTL)="")
- SET PXCA("WARNING","PROBLEM",0,0,0)="Problem List Package is not installed"
- QUIT
- +3 NEW PXCAINDX,PXCAITEM,PXCAITM2,PXCAPROB,PXCAPRV,PXDXDATE
- +4 SET PXDXDATE=$SELECT($DATA(PXCAVSIT)=1:$$CSDATE^PXDXUTL(PXCAVSIT),1:PXCADT)
- +5 SET PXCAPRV=""
- +6 FOR
- SET PXCAPRV=$ORDER(PXCA("PROBLEM",PXCAPRV))
- if PXCAPRV']""
- QUIT
- Begin DoDot:1
- +7 IF '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT)
- SET PXCA("ERROR","PROBLEM",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
- +8 IF '$TEST
- IF PXCABULD!PXCAERRS
- DO ANOTHPRV^PXCAPRV(PXCAPRV)
- +9 SET PXCAINDX=0
- +10 FOR
- SET PXCAINDX=$ORDER(PXCA("PROBLEM",PXCAPRV,PXCAINDX))
- if PXCAINDX']""
- QUIT
- Begin DoDot:2
- +11 SET PXCAPROB=$GET(PXCA("PROBLEM",PXCAPRV,PXCAINDX))
- +12 IF PXCAPROB=""
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM data missing"
- QUIT
- +13 SET PXCAITEM=$PIECE(PXCAPROB,U,1)
- SET PXCAITM2=$LENGTH(PXCAITEM)
- +14 IF PXCAITEM]""
- IF PXCAITM2<2!(PXCAITM2>80)
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,1)="Problem Name must be 2-80 Characters^"_PXCAITEM
- +15 SET PXCAITEM=$PIECE(PXCAPROB,U,2)
- +16 IF PXCAITEM]""
- IF PXCAITEM>DT!(PXCAITEM<1800000)!($PIECE(+PXCAITEM,".")'=PXCAITEM)!(PXCAITEM>+$PIECE($PIECE(PXCA("ENCOUNTER"),"^"),"."))
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="Problem Onset Date is bad^"_PXCAITEM
- +17 SET PXCAITEM=$PIECE(PXCAPROB,U,3)
- +18 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,3)="Problem Active flag bad^"_PXCAITEM
- +19 IF '$TEST
- IF PXCAITEM=""
- SET $PIECE(PXCA("PROBLEM",PXCAPRV,PXCAINDX),U,3)=1
- +20 SET PXCAITEM=$PIECE(PXCAPROB,U,4)
- +21 IF PXCAITEM]""
- IF PXCAITEM>DT!(PXCAITEM<1800000)!($PIECE(+PXCAITEM,".")'=PXCAITEM)!(PXCAITEM>+$PIECE($PIECE(PXCA("ENCOUNTER"),"^"),"."))
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="Problem Resolved Date is bad^"_PXCAITEM
- +22 SET PXCAITEM=$PIECE(PXCAPROB,U,5)
- +23 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,5)="SC flag bad^"_PXCAITEM
- +24 SET PXCAITEM=$PIECE(PXCAPROB,U,6)
- +25 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,6)="AO flag bad^"_PXCAITEM
- +26 SET PXCAITEM=$PIECE(PXCAPROB,U,7)
- +27 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="IR flag bad^"_PXCAITEM
- +28 SET PXCAITEM=$PIECE(PXCAPROB,U,8)
- +29 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,8)="EC flag bad^"_PXCAITEM
- +30 ;PX*1*115 - ADD MST & HNC
- +31 SET PXCAITEM=$PIECE(PXCAPROB,U,13)
- +32 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,13)="MST flag bad^"_PXCAITEM
- +33 SET PXCAITEM=$PIECE(PXCAPROB,U,14)
- +34 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,14)="HNC flag bad^"_PXCAITEM
- +35 SET PXCAITEM=$PIECE(PXCAPROB,U,15)
- +36 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,14)="CV flag bad^"_PXCAITEM
- +37 SET PXCAITEM=$PIECE(PXCAPROB,U,16)
- +38 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,16)="PROJ 112/SHAD flag bad^"_PXCAITEM
- +39 SET PXCAITEM=$PIECE(PXCAPROB,U,9)
- +40 IF PXCAITEM>0
- Begin DoDot:3
- +41 SET PXCADIQ1=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
- +42 IF $PIECE(PXCADIQ1,U,1)'>0
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="Diagnosis Code pointer results in a '"_$PIECE(PXCADIQ1,U,2)_"' error message.^"_PXCAITEM
- +43 IF '$TEST
- IF $PIECE(PXCADIQ1,U,10)'=1
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="Diagnosis Code is INACTIVE^"_PXCAITEM
- End DoDot:3
- +44 SET PXCAITEM=$PIECE(PXCAPROB,U,10)
- +45 IF PXCAITEM]""
- Begin DoDot:3
- +46 IF $GET(^AUPNPROB(PXCAITEM,0))=""
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,10)="Problem not in file 9000011^"_PXCAITEM
- +47 IF '$TEST
- IF PXCAPAT'=$PIECE($GET(^AUPNPROB(PXCAITEM,0)),"^",2)
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,10)="Problem in file 9000011 is for a different Patient^"_PXCAITEM
- End DoDot:3
- +48 IF '$TEST
- SET PXCAITEM=$PIECE(PXCAPROB,U,1)
- IF PXCAITEM']""
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,1)="Problem Name required for a new Problem List entry^"_PXCAITEM
- +49 SET PXCAITEM=$PIECE(PXCAPROB,U,11)
- SET PXCAITM2=$LENGTH(PXCAITEM)
- +50 IF PXCAITM2>60
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,11)="PROBLEM comment must be 1-60 Characters^"_PXCAITEM
- +51 ;
- +52 ;Clinical Lexicon Term
- +53 SET PXCAITEM=$PIECE(PXCAPROB,"^",12)
- +54 IF PXCAITEM]""
- Begin DoDot:3
- +55 IF $DATA(^LEX(757.01))
- Begin DoDot:4
- +56 IF $DATA(^LEX(757.01,PXCAITEM,0))#2'=1
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Lexicon Utility term is not in file 757.01^"_PXCAITEM
- +57 IF '$TEST
- SET PXCACLEX=PXCAITEM
- End DoDot:4
- +58 IF '$TEST
- IF $DATA(^GMP(757.01))
- Begin DoDot:4
- +59 IF $DATA(^GMP(757.01,PXCAITEM,0))#2'=1
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM
- +60 IF '$TEST
- SET PXCACLEX=PXCAITEM
- End DoDot:4
- +61 IF '$TEST
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Lexicon Utility is not installed^"_PXCAITEM
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +62 ;
- +63 QUIT
- +64 ;