- ACHSADTR ;IHS/OIT/FCJ - Display all transactions for a document [ 03/20/97 5:38 PM ]
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**26**;JUN 11, 2001;Build 43
- ;Orig rtn frm Dina Hanson
- ;
- S ACHS("LN")=0
- A ;
- D ^ACHSUD
- G:('$D(ACHSDIEN))!($D(DFOUT))!($D(DUOUT)) EXT
- I '$D(^ACHSF(DUZ(2),"D",ACHSDIEN,0)) U 0 W !!,*7,"No data on file for Doc. #" H 2 G A
- D HEAD
- S ACHS("R")=^ACHSF(DUZ(2),"D",ACHSDIEN,0)
- S ACHS("FY")=$P(ACHS("R"),"^",14),ACHS("DOC")=$P(ACHS("R"),"^",1)
- S ACHS("PAT")=$P(ACHS("R"),"^",22) I ACHS("PAT")'="" S ACHS("PAT")=$P($G(^DPT(ACHS("PAT"),0)),"^",1)
- S ACHS("TY")=$P(ACHS("R"),"^",4),ACHS("TY")=$S(ACHS("TY")=1:43,ACHS("TY")=2:57,ACHS("TY")=3:64)
- S ACHS("V")=$P(ACHS("R"),"^",8),ACHS("V")=$P(^AUTTVNDR(ACHS("V"),0),"^",1)
- U 0 W !,ACHS("FY")_"-"_ACHS("DOC"),?10,ACHS("TY"),?16,ACHS("PAT"),?50,$E(ACHS("V"),1,30),!,"TRANSACTIONS:"
- B ;
- S ACHS=0
- F S ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHS)) G A:+ACHS=0 D
- .Q:'$D(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHS,0))
- .S ACHS("REC")=^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHS,0)
- .S Y=$P(ACHS("REC"),"^",1) X ^DD("DD") S ACHS("DT")=Y
- .S Y=$P(ACHS("REC"),"^",2) S ACHS("TY")=$S(Y="I":"INI",Y="S":"SUP",Y="P":"PAY",Y="ZA":"P ADJ",Y="C":"CAN",1:"")
- .S ACHS("AMT")=$P(ACHS("REC"),"^",4)
- .I ACHS("LN")>20 D PGFULL G A:(Y=0)!(Y="") S ACHS("LN")=1
- .S X=ACHS("AMT"),X2=2 D COMMA^%DTC S ACHS("AMT")=X
- .U 0 W !,?13,ACHS("DT"),?27,ACHS("TY"),?36,$J(ACHS("AMT"),12)
- .S ACHS("LN")=ACHS("LN")+1
- ;
- EXT ;
- K ACHS
- Q
- HEAD ;
- D ^XBCLS
- W !!,"DOC. # TYPE PATIENT",?60,"VENDOR"
- W !,"TRANSACTION DATE TYPE AMT"
- W ! F I=1:1:80 W "-"
- S ACHS("LN")=4
- Q
- PGFULL ;
- S DIR(0)="E" D ^DIR
- Q
- ACHSADTR ;IHS/OIT/FCJ - Display all transactions for a document [ 03/20/97 5:38 PM ]
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**26**;JUN 11, 2001;Build 43
- +2 ;Orig rtn frm Dina Hanson
- +3 ;
- +4 SET ACHS("LN")=0
- A ;
- +1 DO ^ACHSUD
- +2 IF ('$DATA(ACHSDIEN))!($DATA(DFOUT))!($DATA(DUOUT))
- GOTO EXT
- +3 IF '$DATA(^ACHSF(DUZ(2),"D",ACHSDIEN,0))
- USE 0
- WRITE !!,*7,"No data on file for Doc. #"
- HANG 2
- GOTO A
- +4 DO HEAD
- +5 SET ACHS("R")=^ACHSF(DUZ(2),"D",ACHSDIEN,0)
- +6 SET ACHS("FY")=$PIECE(ACHS("R"),"^",14)
- SET ACHS("DOC")=$PIECE(ACHS("R"),"^",1)
- +7 SET ACHS("PAT")=$PIECE(ACHS("R"),"^",22)
- IF ACHS("PAT")'=""
- SET ACHS("PAT")=$PIECE($GET(^DPT(ACHS("PAT"),0)),"^",1)
- +8 SET ACHS("TY")=$PIECE(ACHS("R"),"^",4)
- SET ACHS("TY")=$SELECT(ACHS("TY")=1:43,ACHS("TY")=2:57,ACHS("TY")=3:64)
- +9 SET ACHS("V")=$PIECE(ACHS("R"),"^",8)
- SET ACHS("V")=$PIECE(^AUTTVNDR(ACHS("V"),0),"^",1)
- +10 USE 0
- WRITE !,ACHS("FY")_"-"_ACHS("DOC"),?10,ACHS("TY"),?16,ACHS("PAT"),?50,$EXTRACT(ACHS("V"),1,30),!,"TRANSACTIONS:"
- B ;
- +1 SET ACHS=0
- +2 FOR
- SET ACHS=$ORDER(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHS))
- IF +ACHS=0
- GOTO A
- Begin DoDot:1
- +3 IF '$DATA(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHS,0))
- QUIT
- +4 SET ACHS("REC")=^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHS,0)
- +5 SET Y=$PIECE(ACHS("REC"),"^",1)
- XECUTE ^DD("DD")
- SET ACHS("DT")=Y
- +6 SET Y=$PIECE(ACHS("REC"),"^",2)
- SET ACHS("TY")=$SELECT(Y="I":"INI",Y="S":"SUP",Y="P":"PAY",Y="ZA":"P ADJ",Y="C":"CAN",1:"")
- +7 SET ACHS("AMT")=$PIECE(ACHS("REC"),"^",4)
- +8 IF ACHS("LN")>20
- DO PGFULL
- IF (Y=0)!(Y="")
- GOTO A
- SET ACHS("LN")=1
- +9 SET X=ACHS("AMT")
- SET X2=2
- DO COMMA^%DTC
- SET ACHS("AMT")=X
- +10 USE 0
- WRITE !,?13,ACHS("DT"),?27,ACHS("TY"),?36,$JUSTIFY(ACHS("AMT"),12)
- +11 SET ACHS("LN")=ACHS("LN")+1
- End DoDot:1
- +12 ;
- EXT ;
- +1 KILL ACHS
- +2 QUIT
- HEAD ;
- +1 DO ^XBCLS
- +2 WRITE !!,"DOC. # TYPE PATIENT",?60,"VENDOR"
- +3 WRITE !,"TRANSACTION DATE TYPE AMT"
- +4 WRITE !
- FOR I=1:1:80
- WRITE "-"
- +5 SET ACHS("LN")=4
- +6 QUIT
- PGFULL ;
- +1 SET DIR(0)="E"
- DO ^DIR
- +2 QUIT
