PXCADXP1.m

PXCADXP1 ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into a call to V POV & update Problem List ;3/20/97

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,33**;Aug 12, 1996

 Q

 ;

PART1 ;

 N PXCACLEX

 S (PXCADIAG,PXCAPROB)=0

 I "^^^"'[$P(PXCADXPL,"^",5,8) S PXCAPROB=1

 ;Note

 S PXCAITEM=$P($G(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE")),"^",1),PXCAITM2=$L(PXCAITEM)

 I PXCAITEM]"" D

 . I PXCAITM2<3!(PXCAITM2>60) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE",1)="PROBLEM Note must be 1-60 Characters^"_PXCAITEM

 . S PXCAPROB=1

 ;

 ;Diagnosis Code

 S PXCAITEM=$P(PXCADXPL,"^",1)

 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","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="ICD9 Code not in file 80^"_PXCAITEM

 . E  I $G(PXCADIQ1(80,DA,102,"I")),PXCADIQ1(80,DA,102,"I")'>+PXCADT S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="ICD9 Code is INACTIVE^"_PXCAITEM

 ;

 ;Diagnosis Specification Code

 S PXCAITM2=$P(PXCADXPL,"^",2)

 I PXCAITM2'="" D

 . S PXCADIAG=1

 . I '((PXCAITM2="P")!(PXCAITM2="S")!(PXCAITM2="PS")!(PXCAITM2="SP")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="Diagnosis specification code must be P|S^"_PXCAITM2

 . E  I PXCAITM2["P",PXCAITEM>0 D

 .. I 'PXCAPDX S PXCAPDX=PXCAITEM

 .. E  I $P($G(^PX(815,1,"DI")),"^",2) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis for this encounter^"_PXCAITM2

 .. E  D

 ... S PXCA("WARNING","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis. This one is changed to Secondary^"_PXCAITM2

 ... S $P(PXCADXPL,"^",2)="S"

 . I PXCAITEM'>0 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="ICD9 Code is required for DIAGNOSIS^"_PXCAITEM

 ;

 ;Clinical Lexicon Term

 S PXCAITEM=$P(PXCADXPL,"^",3)

 I PXCAITEM]"" D

 . I $D(^LEX(757.01)) D

 .. I $D(^LEX(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="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","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM

 .. E  S PXCACLEX=PXCAITEM

 . E  S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="Lexicon Utility is not installed^"_PXCAITEM

 ;

 ;Problem List IEN

 S PXCAITEM=$P(PXCADXPL,"^",4)

 ;Add to Problem List

 S PXCAITM2=$P(PXCADXPL,"^",5)

 I PXCAITEM]"" D

 . I $G(^AUPNPROB(PXCAITEM,0))="" S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Problem not in file 9000011^"_PXCAITEM

 . E  I PXCAPAT'=$P($G(^AUPNPROB(PXCAITEM,0)),"^",2) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Problem in file 9000011 is for a different Patient^"_PXCAITEM

 . I PXCAITM2=1 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,5)="Cannot ADD existing Problem to file 9000011^"_PXCAITM2

 E  I PXCAPROB,PXCAITM2'=1 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Cannot update an existing Problem with out an IEN to file 9000011^"_PXCAITEM

 I '(PXCAITM2=1!(PXCAITM2=0)!(PXCAITM2="")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,5)="Add to Problem List flag bad^"_PXCAITM2

 I PXCAITM2=1,PXCAPRV'>0 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="Provider is required to add a new Problem^"_PXCAPRV

 ;

 Q

 ;

PXCADXP1  ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into a call to V POV & update Problem List ;3/20/97

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,33**;Aug 12, 1996

 +2        QUIT 

 +3       ;

PART1     ;

 +1        NEW PXCACLEX

 +2        SET (PXCADIAG,PXCAPROB)=0

 +3        IF "^^^"'[$PIECE(PXCADXPL,"^",5,8)

               SET PXCAPROB=1

 +4       ;Note

 +5        SET PXCAITEM=$PIECE($GET(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE")),"^",1)

           SET PXCAITM2=$LENGTH(PXCAITEM)

 +6        IF PXCAITEM]""

               Begin DoDot:1

 +7                IF PXCAITM2<3!(PXCAITM2>60)

                       SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE",1)="PROBLEM Note must be 1-60 Characters^"_PXCAITEM

 +8                SET PXCAPROB=1

               End DoDot:1

 +9       ;

 +10      ;Diagnosis Code

 +11       SET PXCAITEM=$PIECE(PXCADXPL,"^",1)

 +12       IF PXCAITEM>0

               Begin DoDot:1

 +13               NEW DIC,DR,DA,DIQ,PXCADIQ1

 +14               SET DIC=80

 +15               SET DR=".01;102"

 +16               SET DA=PXCAITEM

 +17               SET DIQ="PXCADIQ1("

 +18               SET DIQ(0)="I"

 +19               DO EN^DIQ1

 +20               IF $GET(PXCADIQ1(80,DA,.01,"I"))=""

                       SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="ICD9 Code not in file 80^"_PXCAITEM

 +21              IF '$TEST

                       IF $GET(PXCADIQ1(80,DA,102,"I"))

                           IF PXCADIQ1(80,DA,102,"I")'>+PXCADT

                               SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="ICD9 Code is INACTIVE^"_PXCAITEM

               End DoDot:1

 +22      ;

 +23      ;Diagnosis Specification Code

 +24       SET PXCAITM2=$PIECE(PXCADXPL,"^",2)

 +25       IF PXCAITM2'=""

               Begin DoDot:1

 +26               SET PXCADIAG=1

 +27               IF '((PXCAITM2="P")!(PXCAITM2="S")!(PXCAITM2="PS")!(PXCAITM2="SP"))

                       SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="Diagnosis specification code must be P|S^"_PXCAITM2

 +28              IF '$TEST

                       IF PXCAITM2["P"

                           IF PXCAITEM>0

                               Begin DoDot:2

 +29                               IF 'PXCAPDX

                                       SET PXCAPDX=PXCAITEM

 +30                              IF '$TEST

                                       IF $PIECE($GET(^PX(815,1,"DI")),"^",2)

                                           SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis for this encounter^"_PXCAITM2

 +31                              IF '$TEST

                                       Begin DoDot:3

 +32                                       SET PXCA("WARNING","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis. This one is changed to Secondary^"_PXCAITM2

 +33                                       SET $PIECE(PXCADXPL,"^",2)="S"

                                       End DoDot:3

                               End DoDot:2

 +34               IF PXCAITEM'>0

                       SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="ICD9 Code is required for DIAGNOSIS^"_PXCAITEM

               End DoDot:1

 +35      ;

 +36      ;Clinical Lexicon Term

 +37       SET PXCAITEM=$PIECE(PXCADXPL,"^",3)

 +38       IF PXCAITEM]""

               Begin DoDot:1

 +39               IF $DATA(^LEX(757.01))

                       Begin DoDot:2

 +40                       IF $DATA(^LEX(757.01,PXCAITEM,0))#2'=1

                               SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="Lexicon Utility term is not in file 757.01^"_PXCAITEM

 +41                      IF '$TEST

                               SET PXCACLEX=PXCAITEM

                       End DoDot:2

 +42              IF '$TEST

                       IF $DATA(^GMP(757.01))

                           Begin DoDot:2

 +43                           IF $DATA(^GMP(757.01,PXCAITEM,0))#2'=1

                                   SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM

 +44                          IF '$TEST

                                   SET PXCACLEX=PXCAITEM

                           End DoDot:2

 +45              IF '$TEST

                       SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="Lexicon Utility is not installed^"_PXCAITEM

               End DoDot:1

 +46      ;

 +47      ;Problem List IEN

 +48       SET PXCAITEM=$PIECE(PXCADXPL,"^",4)

 +49      ;Add to Problem List

 +50       SET PXCAITM2=$PIECE(PXCADXPL,"^",5)

 +51       IF PXCAITEM]""

               Begin DoDot:1

 +52               IF $GET(^AUPNPROB(PXCAITEM,0))=""

                       SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Problem not in file 9000011^"_PXCAITEM

 +53              IF '$TEST

                       IF PXCAPAT'=$PIECE($GET(^AUPNPROB(PXCAITEM,0)),"^",2)

                           SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Problem in file 9000011 is for a different Patient^"_PXCAITEM

 +54               IF PXCAITM2=1

                       SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,5)="Cannot ADD existing Problem to file 9000011^"_PXCAITM2

               End DoDot:1

 +55      IF '$TEST

               IF PXCAPROB

                   IF PXCAITM2'=1

                       SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Cannot update an existing Problem with out an IEN to file 9000011^"_PXCAITEM

 +56       IF '(PXCAITM2=1!(PXCAITM2=0)!(PXCAITM2=""))

               SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,5)="Add to Problem List flag bad^"_PXCAITM2

 +57       IF PXCAITM2=1

               IF PXCAPRV'>0

                   SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="Provider is required to add a new Problem^"_PXCAPRV

 +58      ;

 +59       QUIT 

 +60      ;