APCLAP0.m

APCLAP0 ; IHS/CMI/LAB - INFO FOR APCLAP1 AND APCLAP2 REPORTS ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

GETINFO ;EP

 I $T(@(APCLRPT))="" W !!,$C(7),$C(7),"REPORT INFORMATION MISSING!! NOTIFY PROGRAMMER!",!! S APCLQUIT="" Q

 S APCLINFO=$T(@(APCLRPT)),APCLSORT=$P(APCLINFO,";;",2),APCLPROC=$P(APCLINFO,";;",4),APCLINF=$P(APCLINFO,";;",3),APCLTITL=$P(APCLINFO,";;",5),APCLHD1=$P(APCLINFO,";;",6),APCLHD2=$P(APCLINFO,";;",7)

 Q

 ;

P ;;APCLPROV;;Provider of Service;;PROV;;PROVIDER OF SERVICE;;PROVIDER;;PROVIDER DISCIPLINE

DIS ;;APCLDISC;;Discipline of Provider;;DISC;;DISCIPLINE OF PROVIDER;;DISCIPLINE;;DISCPLINE CODE

C ;;APCLCLIN;;Clinic Type;;CLIN;;CLINIC TYPE;;TYPE OF CLINIC;;CLINIC CODE

ALLDISC ;;APCLADIS;;Provider Discipline (All Providers);;ALLDISC;;ALL PROVIDER DISCIPLINES;;PROVIDER DISCIPLINE;;DISCIPLINE CODE

ALLP ;;APCLSEC;;All Providers of Service;;ALLP;;ALL PROVIDERS OF SERVICE;;PROVIDER OF SERVICE;;DISCIPLINE OF PROV

DISC ;;APCLDISC;;Primary Provider Discipline;;DISC;;PRIMARY PROVIDER DISCIPLINE;;PROVIDER DISCIPLINE;;DISCIPLINE CODE

D ;;APCLDATE;;Date of Visit;;DATE;;DATE OF VISIT;;DATE OF VISIT;;DAY OF WEEK

PROV ;;APCLPROV;;Primary Provider of Service;;PROV;;PRIMARY PROVIDER OF SERVICE;;PROVIDER OF SERVICE;;DISCIPLINE OF PROV

DX ;;APCLDX;;Primary Diagnosis (APC Code);;DX;;PRIMARY DX (APC CODE);;APC DX NARRATIVE;;APC DX CODE

ICD ;;APCLDX;;Primary Diagnosis (ICD Code);;DX;;PRIMARY DX (ICD CODE);;ICD DX NARRATIVE;;ICD DX CODE

LOS ;;APCLVLOC;;Location of Service;;LOS;;LOCATION OF SERVICE;;LOCATION OF SERVICE;;LOCATION CODE

SC ;;APCLCAT;;Service Category of Visit;;SC;;SERVICE CATEGORY OF VISIT;;SERVICE CATEGORY;;CODE

APCC ;;APCLAPCC;;Primary Diagnosis (APC Category);;APCC;;PRIMARY DX (APC CATEGORY);; APC DX CATEGORY NARRATIVE;;  

 Q

DXX ;ENTRY POINT

GETCODE ;

 I $E(APCLX)="." D CODE10 G HIGH

 S APCLICD="09"_($P(APCLICD,".")_$P(APCLICD,".",2))_" "

 I $E(APCLX)="V" S APCLX=(9_$E(APCLX,2,9999)-.000001),APCLX="09V"_$E(APCLX,2,9999),APCLX=$P(APCLX,".")_$P(APCLX,".",2)_" " G HIGH

 S APCLX="09"_APCLX-.000001

 S APCLDX="",APCLX="0"_($P(APCLX,".")_$P(APCLX,".",2))_" "

HIGH S APCLHIGH=$O(^AUTTRCD("AH",APCLX)) I APCLHIGH="" S APCLDX=999 G DX2

 S APCLDA1=$O(^AUTTRCD("AH",APCLHIGH,"")) I APCLDA1="" Q

 S APCLDA2=$O(^AUTTRCD("AH",APCLHIGH,APCLDA1,""))

 S APCLLOW=$P(^AUTTRCD(APCLDA1,11,APCLDA2,0),U)_" "

 I APCLLOW]APCLICD S APCLDX=999 G DX2

 S APCLDX=$P(^AUTTRCD(APCLDA1,0),U,3)

DX2 S APCLSRT2=$P(^AUTTRCD(APCLDA1,0),U)

 Q

 ;

CODE10 ;

 S APCLICD="10"_$P(APCLICD,".",2)_" "

 S APCLX="10"_APCLX,APCLX=APCLX-.000001,APCLX=$P(APCLX,".")_$P(APCLX,".",2)_" "

 Q

APCLAP0   ; IHS/CMI/LAB - INFO FOR APCLAP1 AND APCLAP2 REPORTS ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

GETINFO   ;EP

 +1        IF $TEXT(@(APCLRPT))=""

               WRITE !!,$CHAR(7),$CHAR(7),"REPORT INFORMATION MISSING!! NOTIFY PROGRAMMER!",!!

               SET APCLQUIT=""

               QUIT 

 +2        SET APCLINFO=$TEXT(@(APCLRPT))

           SET APCLSORT=$PIECE(APCLINFO,";;",2)

           SET APCLPROC=$PIECE(APCLINFO,";;",4)

           SET APCLINF=$PIECE(APCLINFO,";;",3)

           SET APCLTITL=$PIECE(APCLINFO,";;",5)

           SET APCLHD1=$PIECE(APCLINFO,";;",6)

           SET APCLHD2=$PIECE(APCLINFO,";;",7)

 +3        QUIT 

 +4       ;

P         ;;APCLPROV;;Provider of Service;;PROV;;PROVIDER OF SERVICE;;PROVIDER;;PROVIDER DISCIPLINE

DIS       ;;APCLDISC;;Discipline of Provider;;DISC;;DISCIPLINE OF PROVIDER;;DISCIPLINE;;DISCPLINE CODE

C         ;;APCLCLIN;;Clinic Type;;CLIN;;CLINIC TYPE;;TYPE OF CLINIC;;CLINIC CODE

ALLDISC   ;;APCLADIS;;Provider Discipline (All Providers);;ALLDISC;;ALL PROVIDER DISCIPLINES;;PROVIDER DISCIPLINE;;DISCIPLINE CODE

ALLP      ;;APCLSEC;;All Providers of Service;;ALLP;;ALL PROVIDERS OF SERVICE;;PROVIDER OF SERVICE;;DISCIPLINE OF PROV

DISC      ;;APCLDISC;;Primary Provider Discipline;;DISC;;PRIMARY PROVIDER DISCIPLINE;;PROVIDER DISCIPLINE;;DISCIPLINE CODE

D         ;;APCLDATE;;Date of Visit;;DATE;;DATE OF VISIT;;DATE OF VISIT;;DAY OF WEEK

PROV      ;;APCLPROV;;Primary Provider of Service;;PROV;;PRIMARY PROVIDER OF SERVICE;;PROVIDER OF SERVICE;;DISCIPLINE OF PROV

DX        ;;APCLDX;;Primary Diagnosis (APC Code);;DX;;PRIMARY DX (APC CODE);;APC DX NARRATIVE;;APC DX CODE

ICD       ;;APCLDX;;Primary Diagnosis (ICD Code);;DX;;PRIMARY DX (ICD CODE);;ICD DX NARRATIVE;;ICD DX CODE

LOS       ;;APCLVLOC;;Location of Service;;LOS;;LOCATION OF SERVICE;;LOCATION OF SERVICE;;LOCATION CODE

SC        ;;APCLCAT;;Service Category of Visit;;SC;;SERVICE CATEGORY OF VISIT;;SERVICE CATEGORY;;CODE

APCC      ;;APCLAPCC;;Primary Diagnosis (APC Category);;APCC;;PRIMARY DX (APC CATEGORY);; APC DX CATEGORY NARRATIVE;;  

 +1        QUIT 

DXX       ;ENTRY POINT

GETCODE   ;

 +1        IF $EXTRACT(APCLX)="."

               DO CODE10

               GOTO HIGH

 +2        SET APCLICD="09"_($PIECE(APCLICD,".")_$PIECE(APCLICD,".",2))_" "

 +3        IF $EXTRACT(APCLX)="V"

               SET APCLX=(9_$EXTRACT(APCLX,2,9999)-.000001)

               SET APCLX="09V"_$EXTRACT(APCLX,2,9999)

               SET APCLX=$PIECE(APCLX,".")_$PIECE(APCLX,".",2)_" "

               GOTO HIGH

 +4        SET APCLX="09"_APCLX-.000001

 +5        SET APCLDX=""

           SET APCLX="0"_($PIECE(APCLX,".")_$PIECE(APCLX,".",2))_" "

HIGH       SET APCLHIGH=$ORDER(^AUTTRCD("AH",APCLX))

           IF APCLHIGH=""

               SET APCLDX=999

               GOTO DX2

 +1        SET APCLDA1=$ORDER(^AUTTRCD("AH",APCLHIGH,""))

           IF APCLDA1=""

               QUIT 

 +2        SET APCLDA2=$ORDER(^AUTTRCD("AH",APCLHIGH,APCLDA1,""))

 +3        SET APCLLOW=$PIECE(^AUTTRCD(APCLDA1,11,APCLDA2,0),U)_" "

 +4        IF APCLLOW]APCLICD

               SET APCLDX=999

               GOTO DX2

 +5        SET APCLDX=$PIECE(^AUTTRCD(APCLDA1,0),U,3)

DX2        SET APCLSRT2=$PIECE(^AUTTRCD(APCLDA1,0),U)

 +1        QUIT 

 +2       ;

CODE10    ;

 +1        SET APCLICD="10"_$PIECE(APCLICD,".",2)_" "

 +2        SET APCLX="10"_APCLX

           SET APCLX=APCLX-.000001

           SET APCLX=$PIECE(APCLX,".")_$PIECE(APCLX,".",2)_" "

 +3        QUIT