Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSRR

ACHSRR.m

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