- 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,121,130,124,168,199**;Aug 12, 1996;Build 51
- Q
- ; Variables
- ; PXCADIAG Copy of a Diagnosis node of the PXCA array
- ; PXCAPRV Pointer to the provider (200)
- ; PXCANPOV Count of the number of POVs
- ; PXCAINDX Count of the number of Diagnoses for one provider
- ;
- DIAG(PXCA,PXCABULD,PXCAERRS) ;Validation routine for POV
- N PXCADIAG,PXCAINDX,PXCAPRV,PXDXDATE
- S PXDXDATE=$S($D(PXCAVSIT)=1:$$CSDATE^PXDXUTL(PXCAVSIT),$D(PXCADT)=1:PXCADT,1:DT)
- S PXCAPRV=""
- 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))
- .. I PXCADIAG="" S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,0)="DIAGNOSIS data missing" Q
- .. S PXCANPOV=PXCANPOV+1
- .. N PXCAITEM,PXCAITM2,PXCAPNAR,PXCANARC,PXCACLEX
- .. ;
- .. S PXCAITEM=$P(PXCADIAG,"^",1)
- .. D
- ... N ICDSTR,ICDCN,ICDID
- ... S ICDSTR=$$ICDDATA^ICDXCODE("DIAG",$S(PXCAITEM'="":PXCAITEM,1:-1),PXDXDATE,"I")
- ... S ICDCN=$P(ICDSTR,"^",2)
- ... S ICDID=$P(ICDSTR,"^",12) I $L(ICDID) S ICDID=$$FMTE^XLFDT(ICDID,5)
- ... I +ICDSTR=-1 S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="Diagnosis Code pointer results in a '"_$P(ICDSTR,U,2)_"' error message.^"_PXCAITEM
- ... E I '$P(ICDSTR,"^",10) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="Diagnosis Code is INACTIVE"_$S($L(ICDID):" as of "_ICDID,1:"")_"^"_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,"^",11)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,11)="MST flag bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCADIAG,"^",12)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,12)="HNC flag bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCADIAG,"^",13)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,13)="CV flag bad^"_PXCAITEM ;CV
- .. S PXCAITEM=$P(PXCADIAG,"^",14)
- .. I '(PXCAITEM="R"!(PXCAITEM="O")!(PXCAITEM="RO")!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,14)="Ordering/Resulting field bad^"_PXCAITEM
- .. S PXCAITEM=$P(PXCADIAG,"^",14)
- .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,15)="PROJ 112/SHAD 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,PXCANPOV,PXCAPRV,PXCAERRS)
- Q
- ;
- ANOTHPOV(PXCAAPOV) ;
- ;Add the diagnoses to V POV if they are not there.
- ;Quit if the provider subscript is zero
- ; Variables
- ; PXCAAPOV Pointer to the ICD DIAGNOSIS file [#80]
- ; PXCAINDX Subscript of the diagnosis in the temp array used to
- ; look to see if the above diagnosis is already known.
- Q:PXCAAPOV'>0
- N PXCAINDX
- ;See if this diagnosis is in the ^TMP(PXCAGLB,$J,
- F PXCAINDX=1:1:PXCANPOV I PXCAAPOV=+$G(^TMP(PXCAGLB,$J,"POV",PXCAINDX,0,"AFTER")) S PXCAINDX=0 Q
- Q:PXCAINDX'>0
- S PXCAINDX=0
- ;See if this diagnosis is already in V POV for this Encounter
- F S PXCAINDX=$O(^AUPNVPOV("AD",PXCAVSIT,PXCAAPOV)) Q:PXCAINDX'>0 I PXCAAPOV=$P(^AUPNVPOV(PXCAINDX,0),"^",1) Q
- Q:PXCAINDX>0
- S PXCANPOV=PXCANPOV+1
- S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,"IEN")=""
- S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,0,"BEFORE")=""
- S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,0,"AFTER")=PXCAAPOV_"^"_PXCAPAT_"^"_PXCAVSIT_"^^^^^^^^^S"
- S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,812,"BEFORE")=""
- S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCAPOV 6041 printed Jan 18, 2025@03:28:38 Page 2
- 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,121,130,124,168,199**;Aug 12, 1996;Build 51
- +2 QUIT
- +3 ; Variables
- +4 ; PXCADIAG Copy of a Diagnosis node of the PXCA array
- +5 ; PXCAPRV Pointer to the provider (200)
- +6 ; PXCANPOV Count of the number of POVs
- +7 ; PXCAINDX Count of the number of Diagnoses for one provider
- +8 ;
- DIAG(PXCA,PXCABULD,PXCAERRS) ;Validation routine for POV
- +1 NEW PXCADIAG,PXCAINDX,PXCAPRV,PXDXDATE
- +2 SET PXDXDATE=$SELECT($DATA(PXCAVSIT)=1:$$CSDATE^PXDXUTL(PXCAVSIT),$DATA(PXCADT)=1:PXCADT,1:DT)
- +3 SET PXCAPRV=""
- +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 IF PXCADIAG=""
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,0)="DIAGNOSIS data missing"
- QUIT
- +12 SET PXCANPOV=PXCANPOV+1
- +13 NEW PXCAITEM,PXCAITM2,PXCAPNAR,PXCANARC,PXCACLEX
- +14 ;
- +15 SET PXCAITEM=$PIECE(PXCADIAG,"^",1)
- +16 Begin DoDot:3
- +17 NEW ICDSTR,ICDCN,ICDID
- +18 SET ICDSTR=$$ICDDATA^ICDXCODE("DIAG",$SELECT(PXCAITEM'="":PXCAITEM,1:-1),PXDXDATE,"I")
- +19 SET ICDCN=$PIECE(ICDSTR,"^",2)
- +20 SET ICDID=$PIECE(ICDSTR,"^",12)
- IF $LENGTH(ICDID)
- SET ICDID=$$FMTE^XLFDT(ICDID,5)
- +21 IF +ICDSTR=-1
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="Diagnosis Code pointer results in a '"_$PIECE(ICDSTR,U,2)_"' error message.^"_PXCAITEM
- +22 IF '$TEST
- IF '$PIECE(ICDSTR,"^",10)
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="Diagnosis Code is INACTIVE"_$SELECT($LENGTH(ICDID):" as of "_ICDID,1:"")_"^"_PXCAITEM
- +23 ;
- End DoDot:3
- +24 SET PXCAITEM=$PIECE(PXCADIAG,"^",2)
- +25 IF '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="S"))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="Diagnosis specification code must be P|S^"_PXCAITEM
- +26 IF '$TEST
- IF PXCAITEM="P"
- Begin DoDot:3
- +27 IF 'PXCAPDX
- SET PXCAPDX=$PIECE(PXCADIAG,"^",1)
- +28 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
- +29 IF '$TEST
- Begin DoDot:4
- +30 SET PXCA("WARNING","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis. This one is changed to Secondary^"_PXCAITEM
- +31 SET $PIECE(PXCADIAG,"^",2)="S"
- End DoDot:4
- End DoDot:3
- +32 SET PXCAITEM=$PIECE(PXCADIAG,"^",3)
- +33 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,3)="SC flag bad^"_PXCAITEM
- +34 SET PXCAITEM=$PIECE(PXCADIAG,"^",4)
- +35 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,4)="AO flag bad^"_PXCAITEM
- +36 SET PXCAITEM=$PIECE(PXCADIAG,"^",5)
- +37 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,5)="IR flag bad^"_PXCAITEM
- +38 SET PXCAITEM=$PIECE(PXCADIAG,"^",6)
- +39 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,6)="EC flag bad^"_PXCAITEM
- +40 SET PXCAITEM=$PIECE(PXCADIAG,"^",11)
- +41 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,11)="MST flag bad^"_PXCAITEM
- +42 SET PXCAITEM=$PIECE(PXCADIAG,"^",12)
- +43 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,12)="HNC flag bad^"_PXCAITEM
- +44 SET PXCAITEM=$PIECE(PXCADIAG,"^",13)
- +45 ;CV
- IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,13)="CV flag bad^"_PXCAITEM
- +46 SET PXCAITEM=$PIECE(PXCADIAG,"^",14)
- +47 IF '(PXCAITEM="R"!(PXCAITEM="O")!(PXCAITEM="RO")!(PXCAITEM=""))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,14)="Ordering/Resulting field bad^"_PXCAITEM
- +48 SET PXCAITEM=$PIECE(PXCADIAG,"^",14)
- +49 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,15)="PROJ 112/SHAD flag bad^"_PXCAITEM
- +50 SET PXCAITEM=$PIECE(PXCADIAG,"^",7)
- +51 IF PXCAITEM]""
- Begin DoDot:3
- +52 IF $GET(^AUPNPROB(PXCAITEM,0))=""
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,7)="Problem not in file 9000011^"_PXCAITEM
- +53 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
- +54 ;
- +55 ;Clinical Lexicon Term
- +56 SET PXCAITEM=$PIECE(PXCADIAG,"^",10)
- +57 IF PXCAITEM]""
- Begin DoDot:3
- +58 IF $DATA(^LEX(757.01))
- Begin DoDot:4
- +59 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
- +60 IF '$TEST
- SET PXCACLEX=PXCAITEM
- End DoDot:4
- +61 IF '$TEST
- IF $DATA(^GMP(757.01))
- Begin DoDot:4
- +62 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
- +63 IF '$TEST
- SET PXCACLEX=PXCAITEM
- End DoDot:4
- +64 IF '$TEST
- SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Lexicon Utility is not installed^"_PXCAITEM
- End DoDot:3
- +65 ;
- +66 DO PART1^PXCAPOV1
- +67 ;
- +68 IF PXCABULD&'$DATA(PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX))!PXCAERRS
- DO POV^PXCADX(PXCADIAG,PXCANPOV,PXCAPRV,PXCAERRS)
- End DoDot:2
- End DoDot:1
- +69 QUIT
- +70 ;
- ANOTHPOV(PXCAAPOV) ;
- +1 ;Add the diagnoses to V POV if they are not there.
- +2 ;Quit if the provider subscript is zero
- +3 ; Variables
- +4 ; PXCAAPOV Pointer to the ICD DIAGNOSIS file [#80]
- +5 ; PXCAINDX Subscript of the diagnosis in the temp array used to
- +6 ; look to see if the above diagnosis is already known.
- +7 if PXCAAPOV'>0
- QUIT
- +8 NEW PXCAINDX
- +9 ;See if this diagnosis is in the ^TMP(PXCAGLB,$J,
- +10 FOR PXCAINDX=1:1:PXCANPOV
- IF PXCAAPOV=+$GET(^TMP(PXCAGLB,$JOB,"POV",PXCAINDX,0,"AFTER"))
- SET PXCAINDX=0
- QUIT
- +11 if PXCAINDX'>0
- QUIT
- +12 SET PXCAINDX=0
- +13 ;See if this diagnosis is already in V POV for this Encounter
- +14 FOR
- SET PXCAINDX=$ORDER(^AUPNVPOV("AD",PXCAVSIT,PXCAAPOV))
- if PXCAINDX'>0
- QUIT
- IF PXCAAPOV=$PIECE(^AUPNVPOV(PXCAINDX,0),"^",1)
- QUIT
- +15 if PXCAINDX>0
- QUIT
- +16 SET PXCANPOV=PXCANPOV+1
- +17 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANPOV,"IEN")=""
- +18 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANPOV,0,"BEFORE")=""
- +19 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANPOV,0,"AFTER")=PXCAAPOV_"^"_PXCAPAT_"^"_PXCAVSIT_"^^^^^^^^^S"
- +20 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANPOV,812,"BEFORE")=""
- +21 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANPOV,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
- +22 QUIT
- +23 ;