- PXCAPOV ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface into PCE's PXK format for POV ;3/20/97
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,33**;Aug 12, 1996
- Q
- ; Variables
- ; PXCADIAG Copy of a Diagnosis node of the PXCA array
- ; PXCAPRV Pointer to the provider (200)
- ; PXCANUMB Count of the number if POVs
- ; PXCAINDX Count of the number of Diagnoses for one provider
- ;
- DIAG(PXCA,PXCABULD,PXCAERRS) ;Validation routine for POV
- N PXCADIAG,PXCAPRV,PXCANUMB,PXCAINDX
- S PXCAPRV=""
- S PXCANUMB=0
- F S PXCAPRV=$O(PXCA("DIAGNOSIS",PXCAPRV)) Q:PXCAPRV']"" D
- . I PXCAPRV>0 D
- .. I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","DIAGNOSIS",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("DIAGNOSIS",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
- .. S PXCADIAG=$G(PXCA("DIAGNOSIS",PXCAPRV,PXCAINDX))
- .. S PXCANUMB=PXCANUMB+1
- .. I PXCADIAG="" S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,0)="DIAGNOSIS data missing" Q
- .. N PXCAITEM,PXCAITM2,PXCAPNAR,PXCANARC,PXCACLEX
- .. ;
- .. S PXCAITEM=$P(PXCADIAG,"^",1)
- .. D
- ... N DIC,DR,DA,DIQ,PXCADIQ1
- ... S DIC=80
- ... S DR=".01;102"
- ... S DA=$S(PXCAITEM'="":PXCAITEM,1:-1)
- ... S DIQ="PXCADIQ1("
- ... S DIQ(0)="I"
- ... D EN^DIQ1
- ... I $G(PXCADIQ1(80,DA,.01,"I"))="" S PXCA("ERROR","DIAGNOSIS",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",PXCAPRV,PXCAINDX,1)="ICD9 Code is INACTIVE^"_PXCAITEM
- .. S PXCAITEM=$P(PXCADIAG,"^",2)
- .. I '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="S")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="Diagnosis specification code must be P|S^"_PXCAITEM
- .. E I PXCAITEM="P" D
- ... I 'PXCAPDX S PXCAPDX=$P(PXCADIAG,"^",1)
- ... E I $P($G(^PX(815,1,"DI")),"^",2) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis for this encounter^"_PXCAITEM
- ... E D
- .... S PXCA("WARNING","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis. This one is changed to Secondary^"_PXCAITEM
- .... S $P(PXCADIAG,"^",2)="S"
- .. S PXCAITEM=$P(PXCADIAG,"^",3)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,3)="SC flag bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCADIAG,"^",4)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,4)="AO flag bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCADIAG,"^",5)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,5)="IR flag bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCADIAG,"^",6)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,6)="EC flag bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCADIAG,"^",7)
- .. I PXCAITEM]"" D
- ... I $G(^AUPNPROB(PXCAITEM,0))="" S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,7)="Problem not in file 9000011^"_PXCAITEM
- ... E I PXCAPAT'=$P($G(^AUPNPROB(PXCAITEM,0)),"^",2) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,7)="Problem in file 9000011 is for a different Patient^"_PXCAITEM
- .. ;
- .. ;Clinical Lexicon Term
- .. S PXCAITEM=$P(PXCADIAG,"^",10)
- .. I PXCAITEM]"" D
- ... I $D(^LEX(757.01)) D
- .... I $D(^LEX(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="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",PXCAPRV,PXCAINDX,10)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM
- .... E S PXCACLEX=PXCAITEM
- ... E S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Lexicon Utility is not installed^"_PXCAITEM
- .. ;
- .. D PART1^PXCAPOV1
- .. ;
- .. I PXCABULD&'$D(PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX))!PXCAERRS D POV^PXCADX(PXCADIAG,PXCANUMB,PXCAPRV,PXCAERRS)
- Q
- ;
- PXCAPOV ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface into PCE's PXK format for POV ;3/20/97
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,33**;Aug 12, 1996
- +2 QUIT
- +3 ; Variables
- +4 ; PXCADIAG Copy of a Diagnosis node of the PXCA array
- +5 ; PXCAPRV Pointer to the provider (200)
- +6 ; PXCANUMB Count of the number if POVs
- +7 ; PXCAINDX Count of the number of Diagnoses for one provider
- +8 ;
- DIAG(PXCA,PXCABULD,PXCAERRS) ;Validation routine for POV
- +1 NEW PXCADIAG,PXCAPRV,PXCANUMB,PXCAINDX
- +2 SET PXCAPRV=""
- +3 SET PXCANUMB=0
- +4 FOR
- SET PXCAPRV=$ORDER(PXCA("DIAGNOSIS",PXCAPRV))
- IF PXCAPRV']""
- QUIT
- Begin DoDot:1
- +5 IF PXCAPRV>0
- Begin DoDot:2
- +6 IF '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT)
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
- +7 IF '$TEST
- IF PXCABULD!PXCAERRS
- DO ANOTHPRV^PXCAPRV(PXCAPRV)
- End DoDot:2
- +8 SET PXCAINDX=0
- +9 FOR
- SET PXCAINDX=$ORDER(PXCA("DIAGNOSIS",PXCAPRV,PXCAINDX))
- IF PXCAINDX']""
- QUIT
- Begin DoDot:2
- +10 SET PXCADIAG=$GET(PXCA("DIAGNOSIS",PXCAPRV,PXCAINDX))
- +11 SET PXCANUMB=PXCANUMB+1
- +12 IF PXCADIAG=""
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,0)="DIAGNOSIS data missing"
- QUIT
- +13 NEW PXCAITEM,PXCAITM2,PXCAPNAR,PXCANARC,PXCACLEX
- +14 ;
- +15 SET PXCAITEM=$PIECE(PXCADIAG,"^",1)
- +16 Begin DoDot:3
- +17 NEW DIC,DR,DA,DIQ,PXCADIQ1
- +18 SET DIC=80
- +19 SET DR=".01;102"
- +20 SET DA=$SELECT(PXCAITEM'="":PXCAITEM,1:-1)
- +21 SET DIQ="PXCADIQ1("
- +22 SET DIQ(0)="I"
- +23 DO EN^DIQ1
- +24 IF $GET(PXCADIQ1(80,DA,.01,"I"))=""
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="ICD9 Code not in file 80^"_PXCAITEM
- +25 IF '$TEST
- IF $GET(PXCADIQ1(80,DA,102,"I"))
- IF PXCADIQ1(80,DA,102,"I")'>+PXCADT
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="ICD9 Code is INACTIVE^"_PXCAITEM
- End DoDot:3
- +26 SET PXCAITEM=$PIECE(PXCADIAG,"^",2)
- +27 IF '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="S"))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="Diagnosis specification code must be P|S^"_PXCAITEM
- +28 IF '$TEST
- IF PXCAITEM="P"
- Begin DoDot:3
- +29 IF 'PXCAPDX
- SET PXCAPDX=$PIECE(PXCADIAG,"^",1)
- +30 IF '$TEST
- IF $PIECE($GET(^PX(815,1,"DI")),"^",2)
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis for this encounter^"_PXCAITEM
- +31 IF '$TEST
- Begin DoDot:4
- +32 SET PXCA("WARNING","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis. This one is changed to Secondary^"_PXCAITEM
- +33 SET $PIECE(PXCADIAG,"^",2)="S"
- End DoDot:4
- End DoDot:3
- +34 SET PXCAITEM=$PIECE(PXCADIAG,"^",3)
- +35 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,3)="SC flag bad^"_PXCAITEM
- +36 SET PXCAITEM=$PIECE(PXCADIAG,"^",4)
- +37 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,4)="AO flag bad^"_PXCAITEM
- +38 SET PXCAITEM=$PIECE(PXCADIAG,"^",5)
- +39 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,5)="IR flag bad^"_PXCAITEM
- +40 SET PXCAITEM=$PIECE(PXCADIAG,"^",6)
- +41 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,6)="EC flag bad^"_PXCAITEM
- +42 SET PXCAITEM=$PIECE(PXCADIAG,"^",7)
- +43 IF PXCAITEM]""
- Begin DoDot:3
- +44 IF $GET(^AUPNPROB(PXCAITEM,0))=""
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,7)="Problem not in file 9000011^"_PXCAITEM
- +45 IF '$TEST
- IF PXCAPAT'=$PIECE($GET(^AUPNPROB(PXCAITEM,0)),"^",2)
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,7)="Problem in file 9000011 is for a different Patient^"_PXCAITEM
- End DoDot:3
- +46 ;
- +47 ;Clinical Lexicon Term
- +48 SET PXCAITEM=$PIECE(PXCADIAG,"^",10)
- +49 IF PXCAITEM]""
- Begin DoDot:3
- +50 IF $DATA(^LEX(757.01))
- Begin DoDot:4
- +51 IF $DATA(^LEX(757.01,PXCAITEM,0))#2'=1
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Lexicon Utility term is not in file 757.01^"_PXCAITEM
- +52 IF '$TEST
- SET PXCACLEX=PXCAITEM
- End DoDot:4
- +53 IF '$TEST
- IF $DATA(^GMP(757.01))
- Begin DoDot:4
- +54 IF $DATA(^GMP(757.01,PXCAITEM,0))#2'=1
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM
- +55 IF '$TEST
- SET PXCACLEX=PXCAITEM
- End DoDot:4
- +56 IF '$TEST
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Lexicon Utility is not installed^"_PXCAITEM
- End DoDot:3
- +57 ;
- +58 DO PART1^PXCAPOV1
- +59 ;
- +60 IF PXCABULD&'$DATA(PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX))!PXCAERRS
- DO POV^PXCADX(PXCADIAG,PXCANUMB,PXCAPRV,PXCAERRS)
- End DoDot:2
- End DoDot:1
- +61 QUIT
- +62 ;
