ACHSAV ; IHS/ITSC/PMF - DOCUMENT DISPLAY ; [ 03/29/2005 3:10 PM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**12**;JUN 11, 2001
;ITSC/SET/JVK ACHS*3.1*12 ADD DHHS # TO DISPLAY 12/22/2004
;
;
;ITSC/SET/JVK ACHS*3.1*12 ADD DHHS NUMBER
I ACHSORDN'="" S ACHSDOFY=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,27)
I ACHSORDN="" S ACHSDOFY=ACHSACFY
I ACHSORDN'="" S ACHSCTYP=$S($P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,2)),U,9)'="":$P(^ACHSF(DUZ(2),"D",ACHSDIEN,2),U,9),1:"")
I $D(ACHSCTYP),ACHSCTYP'="" S ACHSCTYP=$P(^ACHSCTYP(ACHSCTYP,0),U,2)
I ACHSORDN="" S ACHSCTYP=""
S ACHSDHHS="HHSI"_$P($G(^ACHSF(DUZ(2),0)),U,11)_ACHSDOFY_$E(ACHSORDN,3,5)_$E(ACHSORDN,7,11)_ACHSCTYP
W @IOF,"Form # ",$S(ACHSTYP=1:"43",ACHSTYP=2:"57",ACHSTYP=3:"64",1:"") W:ACHSREFT]"" ?55,"REF TYPE" W:ACHSORDN]"" ?68,"Order No."
S T=$S(ACHSTYP=1:"Hospital Service",ACHSTYP=2:"Dental Service",ACHSTYP=3:"Outpatient Service",1:"")
;ITSC/SET/JVK ACHS*3.1*12 COMMENT OUT BELOW AND ADD DHHS #
;W !,$$FMTE^XLFDT(ACHSODT),?80-$L(T)\2,T,?59,ACHSREFT,?79-$L(ACHSORDN),ACHSORDN,!,"-------------------------------------------------------------------------------"
W !,$$FMTE^XLFDT(ACHSODT),?80-$L(T)\2,T,?59,ACHSREFT,?79-$L(ACHSORDN),ACHSORDN,!
W ?44,"HHS Order No:",?79-$L(ACHSDHHS),ACHSDHHS,!,"-------------------------------------------------------------------------------"
S T=$S($G(DFN):"Patient",1:"Description")
W !?39-$L(T)/2,T,?40,"|",?46,"Ordering Facility & Provider"
;
;GET ARRAY VARS SET UP FOR
D ALL^ACHSUDF
;
F I=1:1:4 D
.W !,$E($G(A(I)),1,38)
.W:I=4 ?23,$G(A(5))
.W ?40,"|"
.W ?42,$E($G(B(I)),1,37)
W !,"-------------------------------------------------------------------------------"
W !
W $G(A(6))
W ?40,"|"
W ?42,$E($G(D(1)),1,37)
W !
W $G(A(7))
W ?40,"|"
W ?42,$E($G(D(2)),1,37)
W !
W $G(A(9))
W ?40,"|"
W ?42,$E($G(D(3)),1,37)
W !
W $G(A(10))
W ?40,"|"
W ?42,$E($G(D(4)),1,37)
W ?56,$E($G(F(6)),1,20)
;
;INPATIENT OUTPATIENT
W !?40,"|"
W ?42,$E($G(D(13)),1,35)
W !,"-------------------------------------------------------------------------------",!
W $G(C(4))
W ?42,$G(A(8))
W ?41," SCC: ",$G(F(8))
W:$D(C(4))!$D(A(8)) !
;
W "DCR Acct. = ",$P($G(^ACHS(9,DUZ(2),"RN")),U,ACHSDCR)
W ?42,"CAN/OBJ: ",$G(F(7))," / ",$G(F(9),"N/A")," ",$G(ACHSCOPT,"N/A")
W !?1,"Estimated Charge: ",$G(E(9))
;
I ACHSTYP=1 W ?42,"Days: ",$G(ACHSESDA)
I ACHSTYP=3 W ?42,"Hosp Order No: ",$G(E(10))
K A,B,C,D,E,F
Q
;
ACHSAV ; IHS/ITSC/PMF - DOCUMENT DISPLAY ; [ 03/29/2005 3:10 PM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**12**;JUN 11, 2001
+2 ;ITSC/SET/JVK ACHS*3.1*12 ADD DHHS # TO DISPLAY 12/22/2004
+3 ;
+4 ;
+5 ;ITSC/SET/JVK ACHS*3.1*12 ADD DHHS NUMBER
+6 IF ACHSORDN'=""
SET ACHSDOFY=$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,27)
+7 IF ACHSORDN=""
SET ACHSDOFY=ACHSACFY
+8 IF ACHSORDN'=""
SET ACHSCTYP=$SELECT($PIECE($GET(^ACHSF(DUZ(2),"D",ACHSDIEN,2)),U,9)'="":$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,2),U,9),1:"")
+9 IF $DATA(ACHSCTYP)
IF ACHSCTYP'=""
SET ACHSCTYP=$PIECE(^ACHSCTYP(ACHSCTYP,0),U,2)
+10 IF ACHSORDN=""
SET ACHSCTYP=""
+11 SET ACHSDHHS="HHSI"_$PIECE($GET(^ACHSF(DUZ(2),0)),U,11)_ACHSDOFY_$EXTRACT(ACHSORDN,3,5)_$EXTRACT(ACHSORDN,7,11)_ACHSCTYP
+12 WRITE @IOF,"Form # ",$SELECT(ACHSTYP=1:"43",ACHSTYP=2:"57",ACHSTYP=3:"64",1:"")
IF ACHSREFT]""
WRITE ?55,"REF TYPE"
IF ACHSORDN]""
WRITE ?68,"Order No."
+13 SET T=$SELECT(ACHSTYP=1:"Hospital Service",ACHSTYP=2:"Dental Service",ACHSTYP=3:"Outpatient Service",1:"")
+14 ;ITSC/SET/JVK ACHS*3.1*12 COMMENT OUT BELOW AND ADD DHHS #
+15 ;W !,$$FMTE^XLFDT(ACHSODT),?80-$L(T)\2,T,?59,ACHSREFT,?79-$L(ACHSORDN),ACHSORDN,!,"-------------------------------------------------------------------------------"
+16 WRITE !,$$FMTE^XLFDT(ACHSODT),?80-$LENGTH(T)\2,T,?59,ACHSREFT,?79-$LENGTH(ACHSORDN),ACHSORDN,!
+17 WRITE ?44,"HHS Order No:",?79-$LENGTH(ACHSDHHS),ACHSDHHS,!,"-------------------------------------------------------------------------------"
+18 SET T=$SELECT($GET(DFN):"Patient",1:"Description")
+19 WRITE !?39-$LENGTH(T)/2,T,?40,"|",?46,"Ordering Facility & Provider"
+20 ;
+21 ;GET ARRAY VARS SET UP FOR
+22 DO ALL^ACHSUDF
+23 ;
+24 FOR I=1:1:4
Begin DoDot:1
+25 WRITE !,$EXTRACT($GET(A(I)),1,38)
+26 IF I=4
WRITE ?23,$GET(A(5))
+27 WRITE ?40,"|"
+28 WRITE ?42,$EXTRACT($GET(B(I)),1,37)
End DoDot:1
+29 WRITE !,"-------------------------------------------------------------------------------"
+30 WRITE !
+31 WRITE $GET(A(6))
+32 WRITE ?40,"|"
+33 WRITE ?42,$EXTRACT($GET(D(1)),1,37)
+34 WRITE !
+35 WRITE $GET(A(7))
+36 WRITE ?40,"|"
+37 WRITE ?42,$EXTRACT($GET(D(2)),1,37)
+38 WRITE !
+39 WRITE $GET(A(9))
+40 WRITE ?40,"|"
+41 WRITE ?42,$EXTRACT($GET(D(3)),1,37)
+42 WRITE !
+43 WRITE $GET(A(10))
+44 WRITE ?40,"|"
+45 WRITE ?42,$EXTRACT($GET(D(4)),1,37)
+46 WRITE ?56,$EXTRACT($GET(F(6)),1,20)
+47 ;
+48 ;INPATIENT OUTPATIENT
+49 WRITE !?40,"|"
+50 WRITE ?42,$EXTRACT($GET(D(13)),1,35)
+51 WRITE !,"-------------------------------------------------------------------------------",!
+52 WRITE $GET(C(4))
+53 WRITE ?42,$GET(A(8))
+54 WRITE ?41," SCC: ",$GET(F(8))
+55 IF $DATA(C(4))!$DATA(A(8))
WRITE !
+56 ;
+57 WRITE "DCR Acct. = ",$PIECE($GET(^ACHS(9,DUZ(2),"RN")),U,ACHSDCR)
+58 WRITE ?42,"CAN/OBJ: ",$GET(F(7))," / ",$GET(F(9),"N/A")," ",$GET(ACHSCOPT,"N/A")
+59 WRITE !?1,"Estimated Charge: ",$GET(E(9))
+60 ;
+61 IF ACHSTYP=1
WRITE ?42,"Days: ",$GET(ACHSESDA)
+62 IF ACHSTYP=3
WRITE ?42,"Hosp Order No: ",$GET(E(10))
+63 KILL A,B,C,D,E,F
+64 QUIT
+65 ;
