ACHSEDOC ; IHS/ITSC/PMF - PRINT EOBRS BY PATIENT ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
W $G(IORVON),!,"THIS REPORT WILL ONLY INCLUDE PROCESSED DOCUMENTS. ANY UNPROCESSED",!,"DOCUMENT WILL HAVE TO BE PRINTED USING ANOTHER OPTION.",!!,$G(IORVOFF),!
I '$D(ACHSFC) D ^ACHSVAR ;CHECKS SOME FLAGS TO SEE IF PROCESSING GOING ON
D ^ACHSUD ;SELECT DOCUMENT
I '$D(ACHSDIEN)!($D(DUOUT))!($D(DTOUT)) D END Q ;LEAVE
;
S ACHSDOC0=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,0)) ;GET DOCUMENT 0 RECORD
;
I $G(ACHSDOC0)="" W !!,*7,"Document ",ACHSDIEN," is not complete!" D
.W !!
.D RTRN^ACHS
Q:$G(ACHSQUIT)
;
S ACHSPO="0"_$P(ACHSDOC0,U,14)_"-"_ACHSFC_"-"_$P(ACHSDOC0,U)
S (ACHSTIEN,ACHSX,ACHSPO1,ACHSY)=0
;GET THE TRANSACTIONS FOR THE DOCUMENT
DOC ;
F S ACHSTIEN=$O(^ACHSF(DUZ(2),"EOBR",ACHSDIEN,ACHSTIEN)) Q:+ACHSTIEN=0 D
.S ACHSX=ACHSX+1,ACHSTIEN(ACHSX)=ACHSTIEN
D DOCSEL
Q
DOCSEL ;
I ACHSX=0 D DOCNO Q ;NO DOCUMENTS FOUND
;
S ACHSY=1
;
I ACHSX=1 D DOCPRT D END Q ;IF ONLY ONE DOCUMENT DO IT
;
;
W !!,"ENTRY #",?10,"DOCUMENT #",?30,"PATIENT NAME",?60,"CHART #",?70,"TRANS TYPE",!,$$R("-",79)
S I=""
F S I=$O(ACHSTIEN(I)) Q:I="" D
.D DOCSEL1
.S ACHSY=ACHSY+1
.I ACHSY#10=0 W !!,"Press <RETURN> To Continue ",!! D READ^ACHSFU
DIR ;
S ACHSY=$$DIR^XBDIR("L^1:"_ACHSX,"SELECT ENTRY #(S) TO PRINT")
G END:$D(DUOUT)!$D(DTOUT),DOCPRT
;
DOCSEL1 ;
Q:'$D(ACHSTIEN(I))
S ACHSTIEN=ACHSTIEN(I),ACHSTTYP=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHSTIEN,0),U,2)
S %=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHSTIEN,0),U,3)
I % S ACHSPAT=$P(^DPT(%,0),U,1),ACHSCHRT=$P(^AUPNPAT(%,41,DUZ(2),0),U,2)
E S %=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,3),ACHSPAT=$S(%=1:"* BLANKET",%=2:"* SPECIAL TRANS",1:""),ACHSCHRT="<none>"
S ACHSPO=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,14)_"-"_ACHSFC_"-"_$P(^(0),U,1)
D DOCSELPR
Q
;
DOCSEL2 ;
Q:'$D(ACHSPO1(I))
S ACHSPO1=ACHSPO1(I),ACHSNON=ACHSPO1,ACHSPAT=$P(^ACHSEOBE(ACHSPO1,1),U,1),ACHSCHRT=$P(^AUPNPAT(ACHSPAT,41,DUZ(2),0),U,2),ACHSPAT=$P(^DPT(ACHSPAT,0),U,1),ACHSTTYP=$P(^ACHSEOBE(ACHSPO1,1),U,14)
D DOCSELPR
Q
;
DOCSELPR ;
W !,I_".",?10,ACHSPO,?30,ACHSPAT,?60,ACHSCHRT,?70,ACHSTTYP,!
Q
;
DOCPRT ;
W !!
S %ZIS="P"
D ^%ZIS
I POP D END Q
S ACHSEOIO=IO
D BRPT^ACHSFU
G:ACHSY=0 DOCSEL
F I=1:1 S ACHSX1=$P(ACHSY,",",I) Q:ACHSX1="" D:$D(ACHSTIEN(ACHSX1)) DOCPRT1 ;D:$D(ACHSPO1(ACHSX1)) DOCPRT2
D END
Q
;
DOCPRT1 ;
S ACHSTIEN=ACHSTIEN(ACHSX1)
D ^ACHSEOBA,^ACHSEOB2
Q
;
DOCPRT2 ;
;S ACHSNON=ACHSPO1(ACHSX1)
;D ^ACHSEOBE,^ACHSEOB2
;Q
DOCNO ;
W !!,"NO EOBRS FOR THIS DOCUMENT",!!
D END
Q
;
NON ;
S ACHSN=$$DIR^XBDIR("Y","DO YOU WISH TO PRINT NONPROCESSED EOBRS","","","","",2)
G END:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
Q
;
END ;
D ^%ZISC,EN^XBVK("ACHS"),^ACHSVAR
Q
;
R(X,Y) Q $$REPEAT^XLFSTR(X,Y)
;
ACHSEDOC ; IHS/ITSC/PMF - PRINT EOBRS BY PATIENT ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 WRITE $GET(IORVON),!,"THIS REPORT WILL ONLY INCLUDE PROCESSED DOCUMENTS. ANY UNPROCESSED",!,"DOCUMENT WILL HAVE TO BE PRINTED USING ANOTHER OPTION.",!!,$GET(IORVOFF),!
+4 ;CHECKS SOME FLAGS TO SEE IF PROCESSING GOING ON
IF '$DATA(ACHSFC)
DO ^ACHSVAR
+5 ;SELECT DOCUMENT
DO ^ACHSUD
+6 ;LEAVE
IF '$DATA(ACHSDIEN)!($DATA(DUOUT))!($DATA(DTOUT))
DO END
QUIT
+7 ;
+8 ;GET DOCUMENT 0 RECORD
SET ACHSDOC0=$GET(^ACHSF(DUZ(2),"D",ACHSDIEN,0))
+9 ;
+10 IF $GET(ACHSDOC0)=""
WRITE !!,*7,"Document ",ACHSDIEN," is not complete!"
Begin DoDot:1
+11 WRITE !!
+12 DO RTRN^ACHS
End DoDot:1
+13 IF $GET(ACHSQUIT)
QUIT
+14 ;
+15 SET ACHSPO="0"_$PIECE(ACHSDOC0,U,14)_"-"_ACHSFC_"-"_$PIECE(ACHSDOC0,U)
+16 SET (ACHSTIEN,ACHSX,ACHSPO1,ACHSY)=0
+17 ;GET THE TRANSACTIONS FOR THE DOCUMENT
DOC ;
+1 FOR
SET ACHSTIEN=$ORDER(^ACHSF(DUZ(2),"EOBR",ACHSDIEN,ACHSTIEN))
IF +ACHSTIEN=0
QUIT
Begin DoDot:1
+2 SET ACHSX=ACHSX+1
SET ACHSTIEN(ACHSX)=ACHSTIEN
End DoDot:1
+3 DO DOCSEL
+4 QUIT
DOCSEL ;
+1 ;NO DOCUMENTS FOUND
IF ACHSX=0
DO DOCNO
QUIT
+2 ;
+3 SET ACHSY=1
+4 ;
+5 ;IF ONLY ONE DOCUMENT DO IT
IF ACHSX=1
DO DOCPRT
DO END
QUIT
+6 ;
+7 ;
+8 WRITE !!,"ENTRY #",?10,"DOCUMENT #",?30,"PATIENT NAME",?60,"CHART #",?70,"TRANS TYPE",!,$$R("-",79)
+9 SET I=""
+10 FOR
SET I=$ORDER(ACHSTIEN(I))
IF I=""
QUIT
Begin DoDot:1
+11 DO DOCSEL1
+12 SET ACHSY=ACHSY+1
+13 IF ACHSY#10=0
WRITE !!,"Press <RETURN> To Continue ",!!
DO READ^ACHSFU
End DoDot:1
DIR ;
+1 SET ACHSY=$$DIR^XBDIR("L^1:"_ACHSX,"SELECT ENTRY #(S) TO PRINT")
+2 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO END
GOTO DOCPRT
+3 ;
DOCSEL1 ;
+1 IF '$DATA(ACHSTIEN(I))
QUIT
+2 SET ACHSTIEN=ACHSTIEN(I)
SET ACHSTTYP=$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHSTIEN,0),U,2)
+3 SET %=$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHSTIEN,0),U,3)
+4 IF %
SET ACHSPAT=$PIECE(^DPT(%,0),U,1)
SET ACHSCHRT=$PIECE(^AUPNPAT(%,41,DUZ(2),0),U,2)
+5 IF '$TEST
SET %=$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,3)
SET ACHSPAT=$SELECT(%=1:"* BLANKET",%=2:"* SPECIAL TRANS",1:"")
SET ACHSCHRT="<none>"
+6 SET ACHSPO=$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,14)_"-"_ACHSFC_"-"_$PIECE(^(0),U,1)
+7 DO DOCSELPR
+8 QUIT
+9 ;
DOCSEL2 ;
+1 IF '$DATA(ACHSPO1(I))
QUIT
+2 SET ACHSPO1=ACHSPO1(I)
SET ACHSNON=ACHSPO1
SET ACHSPAT=$PIECE(^ACHSEOBE(ACHSPO1,1),U,1)
SET ACHSCHRT=$PIECE(^AUPNPAT(ACHSPAT,41,DUZ(2),0),U,2)
SET ACHSPAT=$PIECE(^DPT(ACHSPAT,0),U,1)
SET ACHSTTYP=$PIECE(^ACHSEOBE(ACHSPO1,1),U,14)
+3 DO DOCSELPR
+4 QUIT
+5 ;
DOCSELPR ;
+1 WRITE !,I_".",?10,ACHSPO,?30,ACHSPAT,?60,ACHSCHRT,?70,ACHSTTYP,!
+2 QUIT
+3 ;
DOCPRT ;
+1 WRITE !!
+2 SET %ZIS="P"
+3 DO ^%ZIS
+4 IF POP
DO END
QUIT
+5 SET ACHSEOIO=IO
+6 DO BRPT^ACHSFU
+7 IF ACHSY=0
GOTO DOCSEL
+8 ;D:$D(ACHSPO1(ACHSX1)) DOCPRT2
FOR I=1:1
SET ACHSX1=$PIECE(ACHSY,",",I)
IF ACHSX1=""
QUIT
IF $DATA(ACHSTIEN(ACHSX1))
DO DOCPRT1
+9 DO END
+10 QUIT
+11 ;
DOCPRT1 ;
+1 SET ACHSTIEN=ACHSTIEN(ACHSX1)
+2 DO ^ACHSEOBA
DO ^ACHSEOB2
+3 QUIT
+4 ;
DOCPRT2 ;
+1 ;S ACHSNON=ACHSPO1(ACHSX1)
+2 ;D ^ACHSEOBE,^ACHSEOB2
+3 ;Q
DOCNO ;
+1 WRITE !!,"NO EOBRS FOR THIS DOCUMENT",!!
+2 DO END
+3 QUIT
+4 ;
NON ;
+1 SET ACHSN=$$DIR^XBDIR("Y","DO YOU WISH TO PRINT NONPROCESSED EOBRS","","","","",2)
+2 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
GOTO END
+3 QUIT
+4 ;
END ;
+1 DO ^%ZISC
DO EN^XBVK("ACHS")
DO ^ACHSVAR
+2 QUIT
+3 ;
R(X,Y) QUIT $$REPEAT^XLFSTR(X,Y)
+1 ;
