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 ;
