ACHSRR ; IHS/ITSC/PMF - RE-PRINT CHS FORMS ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
A0 ;; Select;
;; 1. Reprint INDIVIDUAL Document(s);
;; ;
;; ;
;; 2. Reprint A Particular 'BATCH' of Documents;
;; ;
;; ;
;
S ACHSREG=0,ACHSRPNT="",ACHSALL=1
K ^TMP("ACHSRR",$J)
;
F ACHS=1:1:6 S ACHS(ACHS)=$P($T(A0+ACHS),";",3)
S ACHS=$P($T(A0),";",3)
S Y=$$DIR^XBDIR("N^1:2",.ACHS,1,"","","^D HELP^ACHS(""H1"",""ACHSRR"")",2)
I $D(DUOUT)!$D(DTOUT) D END Q
G BATPRT:Y=2
A3 ;
;
D ^ACHSUD ;SELECT CHS DOCUMENT ACHSDIEN HOLDS IEN FOR ^ACHSF(,"D"
;
I $D(DUOUT) D END Q
G A0:('$D(ACHSDIEN))&('$D(^TMP("ACHSRR",$J)))
;
;IF DOCUMENTS TO BE PRINTED ARE IN THE TMP FILE AND NO MORE DOCS HAVE
;BEEN CHOSEN THEN CHOOSE A DEVICE IN B1^ACHSRP
I ('$D(ACHSDIEN))&($D(^TMP("ACHSRR",$J))) D B1^ACHSRP D END Q
S (T,ACHSIC)=0
K ACHSWORK
A4 ;
S T=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T)) G A5:+T=0,A4:$P(^(T,0),U,2)="P"
S ACHSIC=ACHSIC+1
I ACHSIC=1 W !!?10,"----------------------------------------------------",!?10,"TRANS",?30,"TRANS",!?11,"NUM",?19,"D A T E",?30,"TYPE",?40,"AMOUNT",!?10,"----------------------------------------------------",!!
I ACHSIC#10=0,$$DIR^XBDIR("E"," Enter '^' to CANCEL ","","","","",1)
I $D(DTOUT) D END Q
G A5:$D(DUOUT)
S ACHSWORK(ACHSIC)=T
;
W ?10,$J(ACHSIC,3)
;'TRANSACTION DATE'
W ?17,$$FMTE^XLFDT($P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0)),U))
;'TRANSACTION TYPE'
W ?32,$P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0)),U,2)
;'FULL PAYMENT'
W $P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0)),U,5)
;'IHS PAYMENT AMOUNT'
W ?35,$J($FN($P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0)),U,4),",",2),11)
;'TRANSACTION TYPE'
W " <",$$EXTSET^XBFUNC(9002080.02,1,$P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0)),U,2)),">",!
G A4
;
A5 ;
G B:ACHSIC=1
S ACHS("PASS")=0
W !!?10,"Print which transaction? (1-",ACHSIC,") "
D READ^ACHSFU
G A7
;
A6 ;
W !!?10,"Print which other transaction? (1-",ACHSIC,") "
D READ^ACHSFU
A7 ;
G A3:$D(DUOUT)!$D(DTOUT)!(Y=""),A8:Y?1"?".E
S Y=+Y
I Y<1!(Y>ACHSIC) W !?10,*7,"Invalid entry - try again." G A6:ACHS("PASS"),A5
D B0 ;SET INTO TMP GLOBAL FOR PRINTING
G A6
;
A8 ;
W !!,"Enter the transaction number for the transaction you wish to print.",!!
G A6
;
B ;
S Y=$$DIR^XBDIR("Y","Do you wish to print this transaction","YES","","","",2)
G A3:$D(DUOUT)!$D(DTOUT)!('Y)
D B0 ;SET INTO TMP GLOBAL FOR PRINTING
G A3
;
;SET INTO TMP GLOBAL FOR PRINTING
B0 ;
S ACHSXT=ACHSWORK(Y)
S ACHSTOS=$$DOC^ACHS(0,4) ;'TYPE OF SERVICE'
S ACHS("PASS")=1
S ^TMP("ACHSRR",$J,DUZ(2),ACHSTOS,ACHSDIEN,ACHSXT)=""
Q
;
BATPRT ; Batch Reprint.
S X1=DT
;'P.O. BATCH PRINT RETAIN DAYS' DEFAULT RETAIN 10 DAYS
S X2=$S(+$P($G(^ACHSF(DUZ(2),0)),U,10):-$P($G(^(0)),U,10),1:-10)
D C^%DTC
S ACHSKDT=9999999-X,(R,ACHSRR)=""
B1 ;
S R=$O(^ACHS(7,"CZ",R))
G C1:R=""
F ACHS=0:0 S ACHSRR=$O(^ACHS(7,"CZ",R,ACHSRR)) G B1:ACHSRR="" S ACHSXDT=9999999-$P($G(^ACHS(7,ACHSRR,0)),U,2) I ACHSXDT'<ACHSKDT D
.;KILL OFF THE 'CHS DOCUMENT PRINTED LIST' ENTRY FOR DATES TO BE PURGED
. K ^ACHS(7,"B",$P(^ACHS(7,ACHSRR,0),U),ACHSRR)
.K ^ACHS(7,"CZ",ACHSXDT,ACHSRR)
.K ^ACHS(7,ACHSRR)
.S $P(^ACHS(7,0),U,4)=$P(^ACHS(7,0),U,4)-1 ;DECREMENT # OF ENTRIES
;
C1 ;
S (R,ACHSRR)="",ACHSIC=0
K ACHSWORK
C2 ;
S R=$O(^ACHS(7,"CZ",R))
G CEND:R=""
C3 ;
S ACHSRR=$O(^ACHS(7,"CZ",R,ACHSRR))
G C2:ACHSRR="",C3:'$D(^ACHS(7,ACHSRR,"D","B"))
S A=""
F ACHS=0:0 Q:$O(^ACHS(7,ACHSRR,"D","B",A))="" S A=$O(^(A))
S ACHSIC=ACHSIC+1
I ACHSIC=1 W !!?10,"---------------------------------------------------------",!?10,"ITM #",?19,"D A T E",?30,"FIRST DOC #",?45,"LAST DOC #",?60,"# DOC'S",!?10,"---------------------------------------------------------",!!
I ACHSIC#10=0 W !?20,"Enter '^' to CANCEL " D READ^ACHSFU G CEND:$D(DUOUT)!$D(DTOUT) W !
S ACHSWORK(ACHSIC)=ACHSRR_U_$O(^ACHS(7,ACHSRR,"D","B",""))_U_A_U_$P($G(^ACHS(7,ACHSRR,"D",0)),U,4)
W ?10,$J(ACHSIC,3),?17,$$FMTE^XLFDT($P($G(^ACHS(7,ACHSRR,0)),U,2)),?30,$P(ACHSWORK(ACHSIC),U,2),?45,$P(ACHSWORK(ACHSIC),U,3),?61,$J($P(ACHSWORK(ACHSIC),U,4),3),!
G C3
;
CEND ;
I ACHSIC=0 W !!,"No 'Batches' on File for Reprinting ",!,"Press RETURN..." D READ^ACHSFU G ACHSRR
W !!?10,"ENTER ITEM # : "
D READ^ACHSFU
I $D(DUOUT)!$D(DTOUT)!(Y="") D END Q
I Y>ACHSIC!(Y<1)!('(Y?1.N))!('$D(ACHSWORK(+Y))) W " Invalid Selection -- TRY AGAIN",*7 G CEND
I Y?1"?".E W !!,"Enter Item Number of 'BATCH' of Documents you wish to REPRINT " G CEND
G ACHSRR:ACHSIC=0,A0:Y=""
S ACHSRR=+$P(ACHSWORK(Y),U)
F R=0:0 S R=$O(^ACHS(7,ACHSRR,"D",R)) Q:'R S ACHSXS=$P($G(^ACHS(7,ACHSRR,"D",R,0)),U,2),ACHSXD=$P($G(^(0)),U,3),ACHSXT=$P($G(^(0)),U,4),ACHSTOS=$P($G(^ACHSF(ACHSXS,"D",ACHSXD,0)),U,4),^TMP("ACHSRR",$J,ACHSXS,ACHSTOS,ACHSXD,ACHSXT)=""
D B1^ACHSRP ;GO BACK TO ASK FOR DEVICE
G A0
;
DATES ; Select range of Dates of P.O.'s to print.
S ACHSBDT=$$DATE^ACHS("B","P.O. print","entry")
S ACHSEDT=$$DATE^ACHS("E","P.O. print","entry")
Q
;
END ;
K A,DTOUT,DUOUT,R,T,X
I $G(ACHSDUZ2) S ^TMP("ACHSDUZ2",$J)=ACHSDUZ2
D EN^XBVK("ACHS"),^ACHSVAR
I $G(^TMP("ACHSDUZ2",$J)) S ACHSDUZ2=$G(^TMP("ACHSDUZ2",$J)) K ^($J)
Q
;
H1 ;EP - From DIR via HELP^ACHS().
;;@;*7
;; Enter Selection 1 or 2 to Select Single or Batch Reprint
;;###
ACHSRR ; IHS/ITSC/PMF - RE-PRINT CHS FORMS ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
A0 ;; Select;
+1 ;; 1. Reprint INDIVIDUAL Document(s);
+2 ;; ;
+3 ;; ;
+4 ;; 2. Reprint A Particular 'BATCH' of Documents;
+5 ;; ;
+6 ;; ;
+7 ;
+8 SET ACHSREG=0
SET ACHSRPNT=""
SET ACHSALL=1
+9 KILL ^TMP("ACHSRR",$JOB)
+10 ;
+11 FOR ACHS=1:1:6
SET ACHS(ACHS)=$PIECE($TEXT(A0+ACHS),";",3)
+12 SET ACHS=$PIECE($TEXT(A0),";",3)
+13 SET Y=$$DIR^XBDIR("N^1:2",.ACHS,1,"","","^D HELP^ACHS(""H1"",""ACHSRR"")",2)
+14 IF $DATA(DUOUT)!$DATA(DTOUT)
DO END
QUIT
+15 IF Y=2
GOTO BATPRT
A3 ;
+1 ;
+2 ;SELECT CHS DOCUMENT ACHSDIEN HOLDS IEN FOR ^ACHSF(,"D"
DO ^ACHSUD
+3 ;
+4 IF $DATA(DUOUT)
DO END
QUIT
+5 IF ('$DATA(ACHSDIEN))&('$DATA(^TMP("ACHSRR",$JOB)))
GOTO A0
+6 ;
+7 ;IF DOCUMENTS TO BE PRINTED ARE IN THE TMP FILE AND NO MORE DOCS HAVE
+8 ;BEEN CHOSEN THEN CHOOSE A DEVICE IN B1^ACHSRP
+9 IF ('$DATA(ACHSDIEN))&($DATA(^TMP("ACHSRR",$JOB)))
DO B1^ACHSRP
DO END
QUIT
+10 SET (T,ACHSIC)=0
+11 KILL ACHSWORK
A4 ;
+1 SET T=$ORDER(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T))
IF +T=0
GOTO A5
IF $PIECE(^(T,0),U,2)="P"
GOTO A4
+2 SET ACHSIC=ACHSIC+1
+3 IF ACHSIC=1
WRITE !!?10,"----------------------------------------------------",!?10,"TRANS",?30,"TRANS",!?11,"NUM",?19,"D A T E",?30,"TYPE",?40,"AMOUNT",!?10,"----------------------------------------------------",!!
+4 IF ACHSIC#10=0
IF $$DIR^XBDIR("E"," Enter '^' to CANCEL ","","","","",1)
+5 IF $DATA(DTOUT)
DO END
QUIT
+6 IF $DATA(DUOUT)
GOTO A5
+7 SET ACHSWORK(ACHSIC)=T
+8 ;
+9 WRITE ?10,$JUSTIFY(ACHSIC,3)
+10 ;'TRANSACTION DATE'
+11 WRITE ?17,$$FMTE^XLFDT($PIECE($GET(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0)),U))
+12 ;'TRANSACTION TYPE'
+13 WRITE ?32,$PIECE($GET(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0)),U,2)
+14 ;'FULL PAYMENT'
+15 WRITE $PIECE($GET(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0)),U,5)
+16 ;'IHS PAYMENT AMOUNT'
+17 WRITE ?35,$JUSTIFY($FNUMBER($PIECE($GET(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0)),U,4),",",2),11)
+18 ;'TRANSACTION TYPE'
+19 WRITE " <",$$EXTSET^XBFUNC(9002080.02,1,$PIECE($GET(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",T,0)),U,2)),">",!
+20 GOTO A4
+21 ;
A5 ;
+1 IF ACHSIC=1
GOTO B
+2 SET ACHS("PASS")=0
+3 WRITE !!?10,"Print which transaction? (1-",ACHSIC,") "
+4 DO READ^ACHSFU
+5 GOTO A7
+6 ;
A6 ;
+1 WRITE !!?10,"Print which other transaction? (1-",ACHSIC,") "
+2 DO READ^ACHSFU
A7 ;
+1 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y="")
GOTO A3
IF Y?1"?".E
GOTO A8
+2 SET Y=+Y
+3 IF Y<1!(Y>ACHSIC)
WRITE !?10,*7,"Invalid entry - try again."
IF ACHS("PASS")
GOTO A6
GOTO A5
+4 ;SET INTO TMP GLOBAL FOR PRINTING
DO B0
+5 GOTO A6
+6 ;
A8 ;
+1 WRITE !!,"Enter the transaction number for the transaction you wish to print.",!!
+2 GOTO A6
+3 ;
B ;
+1 SET Y=$$DIR^XBDIR("Y","Do you wish to print this transaction","YES","","","",2)
+2 IF $DATA(DUOUT)!$DATA(DTOUT)!('Y)
GOTO A3
+3 ;SET INTO TMP GLOBAL FOR PRINTING
DO B0
+4 GOTO A3
+5 ;
+6 ;SET INTO TMP GLOBAL FOR PRINTING
B0 ;
+1 SET ACHSXT=ACHSWORK(Y)
+2 ;'TYPE OF SERVICE'
SET ACHSTOS=$$DOC^ACHS(0,4)
+3 SET ACHS("PASS")=1
+4 SET ^TMP("ACHSRR",$JOB,DUZ(2),ACHSTOS,ACHSDIEN,ACHSXT)=""
+5 QUIT
+6 ;
BATPRT ; Batch Reprint.
+1 SET X1=DT
+2 ;'P.O. BATCH PRINT RETAIN DAYS' DEFAULT RETAIN 10 DAYS
+3 SET X2=$SELECT(+$PIECE($GET(^ACHSF(DUZ(2),0)),U,10):-$PIECE($GET(^(0)),U,10),1:-10)
+4 DO C^%DTC
+5 SET ACHSKDT=9999999-X
SET (R,ACHSRR)=""
B1 ;
+1 SET R=$ORDER(^ACHS(7,"CZ",R))
+2 IF R=""
GOTO C1
+3 FOR ACHS=0:0
SET ACHSRR=$ORDER(^ACHS(7,"CZ",R,ACHSRR))
IF ACHSRR=""
GOTO B1
SET ACHSXDT=9999999-$PIECE($GET(^ACHS(7,ACHSRR,0)),U,2)
IF ACHSXDT'<ACHSKDT
Begin DoDot:1
+4 ;KILL OFF THE 'CHS DOCUMENT PRINTED LIST' ENTRY FOR DATES TO BE PURGED
+5 KILL ^ACHS(7,"B",$PIECE(^ACHS(7,ACHSRR,0),U),ACHSRR)
+6 KILL ^ACHS(7,"CZ",ACHSXDT,ACHSRR)
+7 KILL ^ACHS(7,ACHSRR)
+8 ;DECREMENT # OF ENTRIES
SET $PIECE(^ACHS(7,0),U,4)=$PIECE(^ACHS(7,0),U,4)-1
End DoDot:1
+9 ;
C1 ;
+1 SET (R,ACHSRR)=""
SET ACHSIC=0
+2 KILL ACHSWORK
C2 ;
+1 SET R=$ORDER(^ACHS(7,"CZ",R))
+2 IF R=""
GOTO CEND
C3 ;
+1 SET ACHSRR=$ORDER(^ACHS(7,"CZ",R,ACHSRR))
+2 IF ACHSRR=""
GOTO C2
IF '$DATA(^ACHS(7,ACHSRR,"D","B"))
GOTO C3
+3 SET A=""
+4 FOR ACHS=0:0
IF $ORDER(^ACHS(7,ACHSRR,"D","B",A))=""
QUIT
SET A=$ORDER(^(A))
+5 SET ACHSIC=ACHSIC+1
+6 IF ACHSIC=1
WRITE !!?10,"---------------------------------------------------------",!?10,"ITM #",?19,"D A T E",?30,"FIRST DOC #",?45,"LAST DOC #",?60,"# DOC'S",!?10,"---------------------------------------------------------",!!
+7 IF ACHSIC#10=0
WRITE !?20,"Enter '^' to CANCEL "
DO READ^ACHSFU
IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO CEND
WRITE !
+8 SET ACHSWORK(ACHSIC)=ACHSRR_U_$ORDER(^ACHS(7,ACHSRR,"D","B",""))_U_A_U_$PIECE($GET(^ACHS(7,ACHSRR,"D",0)),U,4)
+9 WRITE ?10,$JUSTIFY(ACHSIC,3),?17,$$FMTE^XLFDT($PIECE($GET(^ACHS(7,ACHSRR,0)),U,2)),?30,$PIECE(ACHSWORK(ACHSIC),U,2),?45,$PIECE(ACHSWORK(ACHSIC),U,3),?61,$JUSTIFY($PIECE(ACHSWORK(ACHSIC),U,4),3),!
+10 GOTO C3
+11 ;
CEND ;
+1 IF ACHSIC=0
WRITE !!,"No 'Batches' on File for Reprinting ",!,"Press RETURN..."
DO READ^ACHSFU
GOTO ACHSRR
+2 WRITE !!?10,"ENTER ITEM # : "
+3 DO READ^ACHSFU
+4 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y="")
DO END
QUIT
+5 IF Y>ACHSIC!(Y<1)!('(Y?1.N))!('$DATA(ACHSWORK(+Y)))
WRITE " Invalid Selection -- TRY AGAIN",*7
GOTO CEND
+6 IF Y?1"?".E
WRITE !!,"Enter Item Number of 'BATCH' of Documents you wish to REPRINT "
GOTO CEND
+7 IF ACHSIC=0
GOTO ACHSRR
IF Y=""
GOTO A0
+8 SET ACHSRR=+$PIECE(ACHSWORK(Y),U)
+9 FOR R=0:0
SET R=$ORDER(^ACHS(7,ACHSRR,"D",R))
IF 'R
QUIT
SET ACHSXS=$PIECE($GET(^ACHS(7,ACHSRR,"D",R,0)),U,2)
SET ACHSXD=$PIECE($GET(^(0)),U,3)
SET ACHSXT=$PIECE($GET(^(0)),U,4)
SET ACHSTOS=$PIECE($GET(^ACHSF(ACHSXS,"D",ACHSXD,0)),U,4)
SET ^TMP("ACHSRR",$JOB,ACHSXS,ACHSTOS,ACHSXD,ACHSXT)=""
+10 ;GO BACK TO ASK FOR DEVICE
DO B1^ACHSRP
+11 GOTO A0
+12 ;
DATES ; Select range of Dates of P.O.'s to print.
+1 SET ACHSBDT=$$DATE^ACHS("B","P.O. print","entry")
+2 SET ACHSEDT=$$DATE^ACHS("E","P.O. print","entry")
+3 QUIT
+4 ;
END ;
+1 KILL A,DTOUT,DUOUT,R,T,X
+2 IF $GET(ACHSDUZ2)
SET ^TMP("ACHSDUZ2",$JOB)=ACHSDUZ2
+3 DO EN^XBVK("ACHS")
DO ^ACHSVAR
+4 IF $GET(^TMP("ACHSDUZ2",$JOB))
SET ACHSDUZ2=$GET(^TMP("ACHSDUZ2",$JOB))
KILL ^($JOB)
+5 QUIT
+6 ;
H1 ;EP - From DIR via HELP^ACHS().
+1 ;;@;*7
+2 ;; Enter Selection 1 or 2 to Select Single or Batch Reprint
+3 ;;###
