ADGICAL.m

ADGICAL ; IHS/ADC/PDW/ENM - INCOMPLETE CHARTS ALPHA LIST ; [ 03/25/1999  11:48 AM ]

 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 ;

 W @IOF,!!!?20,"INCOMPLETE CHARTS ALPHA LIST",!!

 ;***> get date range

BDATE S %DT="AEQ",%DT("A")="Select FIRST Discharge Date in Range: ",X=""

 D ^%DT G END:Y=-1 S DGBDT=Y

EDATE S %DT="AEQ",%DT("A")="Select LAST Discharge Date in Range: ",X=""

 D ^%DT G END:Y=-1 S DGEDT=Y

 ;

SORT ; -- ask user for sort choice

 K DIR S DIR(0)="SO^1:Sort by PATIENT NAME;2:Sort by TERMINAL DIGIT"

 S DIR("A")="Select Choice for Sorting Report" D ^DIR

 G BDATE:$D(DIRUT) S DGSRT=Y

 ;

 ;***> get print device

 W !!,*7,"*** WARNING:  Report uses wide paper or condensed print!",!

 S %ZIS="PQ" D ^%ZIS G END:POP,QUE:$D(IO("Q")) U IO G CALC

QUE K IO("Q") S ZTRTN="CALC^ADGICAL",ZTDESC="INCOM ALPHA"

 F I="DGBDT","DGEDT","DGSRT" S ZTSAVE(I)=""

 D ^%ZTLOAD D ^%ZISC K ZTSK

END K Y,DGBDT,DGEDT D HOME^%ZIS Q

 ;

CALC ;***> Beginning of calculate

 K ^TMP("DGZICAL",$J)

 S DGCNT=0,DGEDT=DGEDT+.2400

 ;

 ;***> loop thru incomplete file by date

 S DGZDT=DGBDT-.0001

C1 S DGZDT=$O(^ADGIC("AB",DGZDT)) G NEXT:DGZDT="",NEXT:DGZDT>DGEDT

 S DFN=0  ;within date loop thru by patient

C2 S DFN=$O(^ADGIC("AB",DGZDT,DFN)) G C1:DFN=""

 S DGDFN1=0   ;within patient loop thru by admission

C3 S DGDFN1=$O(^ADGIC("AB",DGZDT,DFN,DGDFN1)) G C2:DGDFN1=""

 ;

 G C3:'$D(^ADGIC(DFN,"D",DGDFN1,0)) S DGSTR=^(0),DGNM=$P(^DPT(DFN,0),U)

 S DGCHT=$S($D(^AUPNPAT(DFN,41,DUZ(2),0)):$P(^(0),U,2),1:"??")

 ;***> set utility file by patient name

 I DGSRT=1 S ^TMP("DGZICAL",$J,DGNM,DFN,DGDFN1)=DGCHT_U_DGSTR,DGCNT=DGCNT+1

 E  S ^TMP("DGZICAL",$J,$$TERMD,DFN,DGDFN1)=DGCHT_U_DGSTR,DGCNT=DGCNT+1

 G C3

 ;

NEXT G ^ADGICAL1

 ;

 ;

TERMD() ; -- returns terminal digit chart number

 NEW X

 S X=$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2) I X="" Q "??"

 S X="00000"_X,X=$E(X,$L(X)-5,$L(X))

 Q $E(X,5,6)_$E(X,3,4)_$E(X,1,2)

ADGICAL   ; IHS/ADC/PDW/ENM - INCOMPLETE CHARTS ALPHA LIST ; [ 03/25/1999  11:48 AM ]

 +1       ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 +2       ;

 +3        WRITE @IOF,!!!?20,"INCOMPLETE CHARTS ALPHA LIST",!!

 +4       ;***> get date range

BDATE      SET %DT="AEQ"

           SET %DT("A")="Select FIRST Discharge Date in Range: "

           SET X=""

 +1        DO ^%DT

           IF Y=-1

               GOTO END

           SET DGBDT=Y

EDATE      SET %DT="AEQ"

           SET %DT("A")="Select LAST Discharge Date in Range: "

           SET X=""

 +1        DO ^%DT

           IF Y=-1

               GOTO END

           SET DGEDT=Y

 +2       ;

SORT      ; -- ask user for sort choice

 +1        KILL DIR

           SET DIR(0)="SO^1:Sort by PATIENT NAME;2:Sort by TERMINAL DIGIT"

 +2        SET DIR("A")="Select Choice for Sorting Report"

           DO ^DIR

 +3        IF $DATA(DIRUT)

               GOTO BDATE

           SET DGSRT=Y

 +4       ;

 +5       ;***> get print device

 +6        WRITE !!,*7,"*** WARNING:  Report uses wide paper or condensed print!",!

 +7        SET %ZIS="PQ"

           DO ^%ZIS

           IF POP

               GOTO END

           IF $DATA(IO("Q"))

               GOTO QUE

           USE IO

           GOTO CALC

QUE        KILL IO("Q")

           SET ZTRTN="CALC^ADGICAL"

           SET ZTDESC="INCOM ALPHA"

 +1        FOR I="DGBDT","DGEDT","DGSRT"

               SET ZTSAVE(I)=""

 +2        DO ^%ZTLOAD

           DO ^%ZISC

           KILL ZTSK

END        KILL Y,DGBDT,DGEDT

           DO HOME^%ZIS

           QUIT 

 +1       ;

CALC      ;***> Beginning of calculate

 +1        KILL ^TMP("DGZICAL",$JOB)

 +2        SET DGCNT=0

           SET DGEDT=DGEDT+.2400

 +3       ;

 +4       ;***> loop thru incomplete file by date

 +5        SET DGZDT=DGBDT-.0001

C1         SET DGZDT=$ORDER(^ADGIC("AB",DGZDT))

           IF DGZDT=""

               GOTO NEXT

           IF DGZDT>DGEDT

               GOTO NEXT

 +1       ;within date loop thru by patient

           SET DFN=0

C2         SET DFN=$ORDER(^ADGIC("AB",DGZDT,DFN))

           IF DFN=""

               GOTO C1

 +1       ;within patient loop thru by admission

           SET DGDFN1=0

C3         SET DGDFN1=$ORDER(^ADGIC("AB",DGZDT,DFN,DGDFN1))

           IF DGDFN1=""

               GOTO C2

 +1       ;

 +2        IF '$DATA(^ADGIC(DFN,"D",DGDFN1,0))

               GOTO C3

           SET DGSTR=^(0)

           SET DGNM=$PIECE(^DPT(DFN,0),U)

 +3        SET DGCHT=$SELECT($DATA(^AUPNPAT(DFN,41,DUZ(2),0)):$PIECE(^(0),U,2),1:"??")

 +4       ;***> set utility file by patient name

 +5        IF DGSRT=1

               SET ^TMP("DGZICAL",$JOB,DGNM,DFN,DGDFN1)=DGCHT_U_DGSTR

               SET DGCNT=DGCNT+1

 +6       IF '$TEST

               SET ^TMP("DGZICAL",$JOB,$$TERMD,DFN,DGDFN1)=DGCHT_U_DGSTR

               SET DGCNT=DGCNT+1

 +7        GOTO C3

 +8       ;

NEXT       GOTO ^ADGICAL1

 +1       ;

 +2       ;

TERMD()   ; -- returns terminal digit chart number

 +1        NEW X

 +2        SET X=$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)

           IF X=""

               QUIT "??"

 +3        SET X="00000"_X

           SET X=$EXTRACT(X,$LENGTH(X)-5,$LENGTH(X))

 +4        QUIT $EXTRACT(X,5,6)_$EXTRACT(X,3,4)_$EXTRACT(X,1,2)