- PXCAPL ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface into a call to update Problem List ;3/20/97
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,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
- ;
- ;
- 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 PXCAPROB,PXCAPRV,PXCAINDX
- N PXCAITEM,PXCAITM2
- 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,9)
- .. I PXCAITEM>0 D
- ... N DIC,DR,DA,DIQ,PXCADIQ1
- ... S DIC=80
- ... S DR=".01;102"
- ... S DA=PXCAITEM
- ... S DIQ="PXCADIQ1("
- ... S DIQ(0)="I"
- ... D EN^DIQ1
- ... I $G(PXCADIQ1(80,DA,.01,"I"))="" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="ICD9 Code not in file 80^"_PXCAITEM
- ... E I $G(PXCADIQ1(80,DA,102,"I")),PXCADIQ1(80,DA,102,"I")'>+PXCADT S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="ICD9 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
- ;
- PXCAPL ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface into a call to update Problem List ;3/20/97
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,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 ;
- +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 PXCAPROB,PXCAPRV,PXCAINDX
- +4 NEW PXCAITEM,PXCAITM2
- +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,9)
- +36 IF PXCAITEM>0
- Begin DoDot:3
- +37 NEW DIC,DR,DA,DIQ,PXCADIQ1
- +38 SET DIC=80
- +39 SET DR=".01;102"
- +40 SET DA=PXCAITEM
- +41 SET DIQ="PXCADIQ1("
- +42 SET DIQ(0)="I"
- +43 DO EN^DIQ1
- +44 IF $GET(PXCADIQ1(80,DA,.01,"I"))=""
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="ICD9 Code not in file 80^"_PXCAITEM
- +45 IF '$TEST
- IF $GET(PXCADIQ1(80,DA,102,"I"))
- IF PXCADIQ1(80,DA,102,"I")'>+PXCADT
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="ICD9 Code is INACTIVE^"_PXCAITEM
- End DoDot:3
- +46 SET PXCAITEM=$PIECE(PXCAPROB,U,10)
- +47 IF PXCAITEM]""
- Begin DoDot:3
- +48 IF $GET(^AUPNPROB(PXCAITEM,0))=""
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,10)="Problem not in file 9000011^"_PXCAITEM
- +49 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
- +50 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
- +51 SET PXCAITEM=$PIECE(PXCAPROB,U,11)
- SET PXCAITM2=$LENGTH(PXCAITEM)
- +52 IF PXCAITM2>60
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,11)="PROBLEM comment must be 1-60 Characters^"_PXCAITEM
- +53 ;
- +54 ;Clinical Lexicon Term
- +55 SET PXCAITEM=$PIECE(PXCAPROB,"^",12)
- +56 IF PXCAITEM]""
- Begin DoDot:3
- +57 IF $DATA(^LEX(757.01))
- Begin DoDot:4
- +58 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
- +59 IF '$TEST
- SET PXCACLEX=PXCAITEM
- End DoDot:4
- +60 IF '$TEST
- IF $DATA(^GMP(757.01))
- Begin DoDot:4
- +61 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
- +62 IF '$TEST
- SET PXCACLEX=PXCAITEM
- End DoDot:4
- +63 IF '$TEST
- SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Lexicon Utility is not installed^"_PXCAITEM
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +64 ;
- +65 QUIT
- +66 ;
