- 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 ;
