ACHSPDC1.m

ACHSPDC1 ; IHS/ITSC/PMF - CONTINUATION OF VIEW/PRINT DOCUMENTS FOR PAITENT ;   [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 ;

START ;EP - From TaskMan.

 S:$D(ZTQUEUED) ACHSQUIT=0

 D FC^ACHSUF

 I $G(ACHSERR)=1 G K

 S (ACHSTOT,ACHSCANC,ACHSCTOT,ACHSTOT("$"),ACHSDOC)=0

 S ACHST1=$$C^XBFUNC("PATIENT: "_$P(^DPT(DFN,0),U)_"    CHART #: "_$$HRN^ACHS(DFN,DUZ(2)),80)

 S ACHST2=$$C^XBFUNC("For the period "_$$FMTE^XLFDT(ACHSBDT)_" through "_$$FMTE^XLFDT(ACHSEDT),80)

 S ACHSTOS=$P(^DD(9002080.01,3,0),U,3),ACHSSTS=$P(^DD(9002080.01,11,0),U,3),ACHST3=$$C^XBFUNC($S(ACHSRPT:$P($P(ACHSTOS,";",ACHSRPT),":",2)_" documents ONLY",1:"All Documents"),80)

 D BRPT^ACHSFU

 X:$D(IO("S")) ACHSPPO

 D HDR

DUZ2 ;

 K ACHSDVEW

 S ACHSVQIT=0

 D FC

 S ACHSFAC=$P(^AUTTLOC($O(^AUTTLOC("B",DUZ(2),0)),0),U,10)

A ; Main loop.

 S ACHSDOC=$O(^ACHSF(DUZ(2),"PB",DFN,ACHSDOC))

 G END:ACHSDOC=""

 S ACHSDOC0=$G(^ACHSF(DUZ(2),"D",ACHSDOC,0))

 G A:+$P(ACHSDOC0,U,2)<ACHSBDT,A:+$P(ACHSDOC0,U,2)>ACHSEDT,A:(ACHSRPT'="ALL")&(ACHSRPT'=$P(ACHSDOC0,U,4))

 W ACHSFAC,?7,$P(ACHSDOC0,U,14),ACHSFC,$P(ACHSDOC0,U)

 K Y

 I $D(^ACHSF(DUZ(2),"D",ACHSDOC,3)),+$P(^(3),U)>0 S Y=+$P(^(3),U)

 S:'$D(Y) Y=+$P(ACHSDOC0,U,2)

 W ?17,$E(Y,2,7)

 I +$P(ACHSDOC0,U,8),$D(^AUTTVNDR(+$P(ACHSDOC0,U,8),0)) W ?24,$E($P(^(0),U),1,22)

 W ?47,$E($P($P(ACHSTOS,";",$P(ACHSDOC0,U,4)),":",2),1,2)

 I $D(^ACHSF(DUZ(2),"D",ACHSDOC,"PA")) S X=$S($D(^("ZA")):+^("ZA"),1:+^("PA")) G P6

 S X=$S($D(^ACHSF(DUZ(2),"D",ACHSDOC,"PA")):+^("PA"),1:$P(ACHSDOC0,U,9))

 I $P(ACHSDOC0,U,12)=4 S X=0,ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDOC,"T",0)) F  Q:+ACHS=0  S X=+$P(^(ACHS,0),U,4),ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDOC,"T",ACHS))

 I $P(ACHSDOC0,U,12)=4 S ACHSCANC=ACHSCANC+X

P6 ;

 I $P(ACHSDOC0,U,12)]"" W ?52,$P($P(ACHSSTS,";",$P(ACHSDOC0,U,12)+1),":",2)

 S ACHSTOT("$")=ACHSTOT("$")+X,ACHSCTOT=ACHSTOT("$")-ACHSCANC

 W ?69

 S X3=10

 D FMT^ACHS

 W !

 I IOST["C-",$Y>24 G DISPLAY

 ;

 I IOST'["C-",$Y>ACHSBM D CPI^ACHS D RTRN^ACHS G K:$G(ACHSQUIT) D HDR

 S ACHSTOT=ACHSTOT+1

 G A

 ;

END ;

 W ?69,"----------",!,"Total documents seen: ",ACHSTOT,?69

 S X=ACHSTOT("$"),X3=10

 D FMT^ACHS

 W !!?45,"LESS CANCELS",?68

 S X=-ACHSCANC,X3=10

 D FMT^ACHS

 W !?69,"==========",!?69

 S X=ACHSCTOT,X3=10

 D FMT^ACHS

 I IOST["C-",$Y>15 S ACHSVQIT=1 D DISPLAY

 D:IOST'["C-" CPI^ACHS

K ;EP - Kill vars, do ERPT, quit.

 D EN^XBVK("ACHS"),^ACHSVAR

 K DFN

 D ERPT^ACHS

 Q

 ;

HDR ; Print header.

 S ACHSPG=ACHSPG+1

 W @IOF

 D CPI^ACHS:IOST'["C-"

 W !,ACHS("*"),!?22,"CHS DOCUMENTS FOR A SPECIFIC PATIENT",!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,ACHST1,!,ACHST2,!,ACHST3,!,ACHS("*")

 W !,"FAC",?7,"DOCUMENT",?17,"DATED",?24,"VENDOR",?47,"TYPE",?52,"STATUS",?69,"AMOUNT",!,$$REPEAT^XLFSTR("-",79),!

 Q

 ;

FC ; Set Finance Code.

 S ACHSFC=$P(^AUTTLOC(DUZ(2),0),U,17)

 I $L(ACHSFC)'=3 S ACHSFC="???" Q

 S ACHSFC=$P(^AUTTAREA($P(^AUTTLOC(DUZ(2),0),U,4),0),U,3)_$E(ACHSFC,2,3)

 Q

 ;

DISPLAY ; View document selected from the report.

 K DIR

 S DIR(0)="Y",DIR("A")="Do you want to view one of the documents listed",DIR("B")="NO"

 D ^DIR

 K DIR

 I Y=0,ACHSVQIT=0 D HDR S ACHSTOT=ACHSTOT+1 G A

 I Y=0 Q

 I ACHSVQIT=1,Y=0,ACHSPG>1,$Y>24 G AGAIN

 S ACHSDVEW=0

 D ^ACHSAD

 K DIR

 S DIR(0)="E"

 W !!

 D ^DIR

 G K:Y=0

 I ACHSVQIT'=1 D HDR G A

AGAIN ;

 K DIR

 S DIR(0)="Y",DIR("A")="View document list again",DIR("B")="NO"

 W !!!

 D ^DIR

 I Y=1 S (ACHSVQIT,ACHSTOT,ACHSTOT("$"),ACHSPG)=0,ACHSDOC="" D HDR G A

 G K

 ;

ACHSPDC1  ; IHS/ITSC/PMF - CONTINUATION OF VIEW/PRINT DOCUMENTS FOR PAITENT ;   [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;

START     ;EP - From TaskMan.

 +1        IF $DATA(ZTQUEUED)

               SET ACHSQUIT=0

 +2        DO FC^ACHSUF

 +3        IF $GET(ACHSERR)=1

               GOTO K

 +4        SET (ACHSTOT,ACHSCANC,ACHSCTOT,ACHSTOT("$"),ACHSDOC)=0

 +5        SET ACHST1=$$C^XBFUNC("PATIENT: "_$PIECE(^DPT(DFN,0),U)_"    CHART #: "_$$HRN^ACHS(DFN,DUZ(2)),80)

 +6        SET ACHST2=$$C^XBFUNC("For the period "_$$FMTE^XLFDT(ACHSBDT)_" through "_$$FMTE^XLFDT(ACHSEDT),80)

 +7        SET ACHSTOS=$PIECE(^DD(9002080.01,3,0),U,3)

           SET ACHSSTS=$PIECE(^DD(9002080.01,11,0),U,3)

           SET ACHST3=$$C^XBFUNC($SELECT(ACHSRPT:$PIECE($PIECE(ACHSTOS,";",ACHSRPT),":",2)_" documents ONLY",1:"All Documents"),80)

 +8        DO BRPT^ACHSFU

 +9        IF $DATA(IO("S"))

               XECUTE ACHSPPO

 +10       DO HDR

DUZ2      ;

 +1        KILL ACHSDVEW

 +2        SET ACHSVQIT=0

 +3        DO FC

 +4        SET ACHSFAC=$PIECE(^AUTTLOC($ORDER(^AUTTLOC("B",DUZ(2),0)),0),U,10)

A         ; Main loop.

 +1        SET ACHSDOC=$ORDER(^ACHSF(DUZ(2),"PB",DFN,ACHSDOC))

 +2        IF ACHSDOC=""

               GOTO END

 +3        SET ACHSDOC0=$GET(^ACHSF(DUZ(2),"D",ACHSDOC,0))

 +4        IF +$PIECE(ACHSDOC0,U,2)<ACHSBDT

               GOTO A

           IF +$PIECE(ACHSDOC0,U,2)>ACHSEDT

               GOTO A

           IF (ACHSRPT'="ALL")&(ACHSRPT'=$PIECE(ACHSDOC0,U,4))

               GOTO A

 +5        WRITE ACHSFAC,?7,$PIECE(ACHSDOC0,U,14),ACHSFC,$PIECE(ACHSDOC0,U)

 +6        KILL Y

 +7        IF $DATA(^ACHSF(DUZ(2),"D",ACHSDOC,3))

               IF +$PIECE(^(3),U)>0

                   SET Y=+$PIECE(^(3),U)

 +8        IF '$DATA(Y)

               SET Y=+$PIECE(ACHSDOC0,U,2)

 +9        WRITE ?17,$EXTRACT(Y,2,7)

 +10       IF +$PIECE(ACHSDOC0,U,8)

               IF $DATA(^AUTTVNDR(+$PIECE(ACHSDOC0,U,8),0))

                   WRITE ?24,$EXTRACT($PIECE(^(0),U),1,22)

 +11       WRITE ?47,$EXTRACT($PIECE($PIECE(ACHSTOS,";",$PIECE(ACHSDOC0,U,4)),":",2),1,2)

 +12       IF $DATA(^ACHSF(DUZ(2),"D",ACHSDOC,"PA"))

               SET X=$SELECT($DATA(^("ZA")):+^("ZA"),1:+^("PA"))

               GOTO P6

 +13       SET X=$SELECT($DATA(^ACHSF(DUZ(2),"D",ACHSDOC,"PA")):+^("PA"),1:$PIECE(ACHSDOC0,U,9))

 +14       IF $PIECE(ACHSDOC0,U,12)=4

               SET X=0

               SET ACHS=$ORDER(^ACHSF(DUZ(2),"D",ACHSDOC,"T",0))

               FOR 

                   IF +ACHS=0

                       QUIT 

                   SET X=+$PIECE(^(ACHS,0),U,4)

                   SET ACHS=$ORDER(^ACHSF(DUZ(2),"D",ACHSDOC,"T",ACHS))

 +15       IF $PIECE(ACHSDOC0,U,12)=4

               SET ACHSCANC=ACHSCANC+X

P6        ;

 +1        IF $PIECE(ACHSDOC0,U,12)]""

               WRITE ?52,$PIECE($PIECE(ACHSSTS,";",$PIECE(ACHSDOC0,U,12)+1),":",2)

 +2        SET ACHSTOT("$")=ACHSTOT("$")+X

           SET ACHSCTOT=ACHSTOT("$")-ACHSCANC

 +3        WRITE ?69

 +4        SET X3=10

 +5        DO FMT^ACHS

 +6        WRITE !

 +7        IF IOST["C-"

               IF $Y>24

                   GOTO DISPLAY

 +8       ;

 +9        IF IOST'["C-"

               IF $Y>ACHSBM

                   DO CPI^ACHS

                   DO RTRN^ACHS

                   IF $GET(ACHSQUIT)

                       GOTO K

                   DO HDR

 +10       SET ACHSTOT=ACHSTOT+1

 +11       GOTO A

 +12      ;

END       ;

 +1        WRITE ?69,"----------",!,"Total documents seen: ",ACHSTOT,?69

 +2        SET X=ACHSTOT("$")

           SET X3=10

 +3        DO FMT^ACHS

 +4        WRITE !!?45,"LESS CANCELS",?68

 +5        SET X=-ACHSCANC

           SET X3=10

 +6        DO FMT^ACHS

 +7        WRITE !?69,"==========",!?69

 +8        SET X=ACHSCTOT

           SET X3=10

 +9        DO FMT^ACHS

 +10       IF IOST["C-"

               IF $Y>15

                   SET ACHSVQIT=1

                   DO DISPLAY

 +11       IF IOST'["C-"

               DO CPI^ACHS

K         ;EP - Kill vars, do ERPT, quit.

 +1        DO EN^XBVK("ACHS")

           DO ^ACHSVAR

 +2        KILL DFN

 +3        DO ERPT^ACHS

 +4        QUIT 

 +5       ;

HDR       ; Print header.

 +1        SET ACHSPG=ACHSPG+1

 +2        WRITE @IOF

 +3        IF IOST'["C-"

               DO CPI^ACHS

 +4        WRITE !,ACHS("*"),!?22,"CHS DOCUMENTS FOR A SPECIFIC PATIENT",!,ACHSUSR,?71,"Page",$JUSTIFY(ACHSPG,3),!,ACHST1,!,ACHST2,!,ACHST3,!,ACHS("*")

 +5        WRITE !,"FAC",?7,"DOCUMENT",?17,"DATED",?24,"VENDOR",?47,"TYPE",?52,"STATUS",?69,"AMOUNT",!,$$REPEAT^XLFSTR("-",79),!

 +6        QUIT 

 +7       ;

FC        ; Set Finance Code.

 +1        SET ACHSFC=$PIECE(^AUTTLOC(DUZ(2),0),U,17)

 +2        IF $LENGTH(ACHSFC)'=3

               SET ACHSFC="???"

               QUIT 

 +3        SET ACHSFC=$PIECE(^AUTTAREA($PIECE(^AUTTLOC(DUZ(2),0),U,4),0),U,3)_$EXTRACT(ACHSFC,2,3)

 +4        QUIT 

 +5       ;

DISPLAY   ; View document selected from the report.

 +1        KILL DIR

 +2        SET DIR(0)="Y"

           SET DIR("A")="Do you want to view one of the documents listed"

           SET DIR("B")="NO"

 +3        DO ^DIR

 +4        KILL DIR

 +5        IF Y=0

               IF ACHSVQIT=0

                   DO HDR

                   SET ACHSTOT=ACHSTOT+1

                   GOTO A

 +6        IF Y=0

               QUIT 

 +7        IF ACHSVQIT=1

               IF Y=0

                   IF ACHSPG>1

                       IF $Y>24

                           GOTO AGAIN

 +8        SET ACHSDVEW=0

 +9        DO ^ACHSAD

 +10       KILL DIR

 +11       SET DIR(0)="E"

 +12       WRITE !!

 +13       DO ^DIR

 +14       IF Y=0

               GOTO K

 +15       IF ACHSVQIT'=1

               DO HDR

               GOTO A

AGAIN     ;

 +1        KILL DIR

 +2        SET DIR(0)="Y"

           SET DIR("A")="View document list again"

           SET DIR("B")="NO"

 +3        WRITE !!!

 +4        DO ^DIR

 +5        IF Y=1

               SET (ACHSVQIT,ACHSTOT,ACHSTOT("$"),ACHSPG)=0

               SET ACHSDOC=""

               DO HDR

               GOTO A

 +6        GOTO K

 +7       ;