- ACHSRDOS ;IHS/OIT/FCJ - ESTIMATED DATE OF SERVICE REPORT FOR CHS [ 07/24/2000 10:57 AM ]
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001;Build 43
- ;
- S ACHSIO=IO,ACHSPG=0
- D BM^ACHSFU
- W !,"Report for Actual or Estimated DOS with Issue Date"
- DOCS ; Select type of docs to print.
- S ACHSRPT=$$DIR^XBDIR("S^1:Actual Date of Service;2:Estimated Date of Service","Print which documents","1","","","^D HELP^ACHS(""H1"",""ACHSRDOS"")",2)
- G EXT:$D(DUOUT)!$D(DTOUT)
- S ACHSRPT1=$S(ACHSRPT=1:"Actual Date of Service",1:"Estimated Date of Service")
- BDT ; Enter beginning date.
- S ACHSBDT=$$DATE^ACHS("B",ACHSRPT1,"")
- G EXT:$D(DUOUT)!$D(DTOUT)!(ACHSBDT<1)
- EDT ; Enter the ending date.
- S ACHSEDT=$$DATE^ACHS("E",ACHSRPT1,"")
- G BDT:$D(DUOUT),EXT:$D(DTOUT)!(ACHSEDT<1),EDT:$$EBB^ACHS(ACHSBDT,ACHSEDT)
- DEV ; Select device for report.
- W !
- S %=$$PB^ACHS
- I %=U!$D(DTOUT)!$D(DUOUT) D EXT Q
- I %="B" D VIEWR^XBLM("TRNS^ACHSRDOS"),EN^XBVK("VALM") D EXT Q
- K IOP,%ZIS
- S %ZIS="PQ"
- D ^%ZIS,SLV^ACHSFU:$D(IO("S"))
- K %ZIS
- I POP W !,*7,"No device specified." D HOME^%ZIS G EXT
- G:'$D(IO("Q")) TRNS
- K IO("Q")
- I $E(IOST)'="P" W *7,!,"Please queue to printers only." G DEV
- S ZTIO="",ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL,ZTRTN="TRNS^ACHSRDOS",ZTDESC="CHS "_ACHSRPT1_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)
- F %="ACHSQIO","ACHSBDT","ACHSRPT","ACHSEDT","ACHSRPT1" S ZTSAVE(%)=""
- D ^%ZTLOAD
- G:'$D(ZTSK) DEV
- ;
- ;end of interactive portion. The rest performed by Taskman
- ;
- TRNS ;START OF TRANSACTIONS
- W !
- S ACHSQUIT=0,ACHSBDT1=ACHSBDT-1
- I ACHSRPT=1 F S ACHSBDT1=$O(^ACHSF(DUZ(2),"PDOS",ACHSBDT1)) Q:(ACHSBDT1>ACHSEDT)!(ACHSBDT1="") D Q:ACHSQUIT
- .S ACHSDIEN=0 F S ACHSDIEN=$O(^ACHSF(DUZ(2),"PDOS",ACHSBDT1,ACHSDIEN)) Q:ACHSDIEN="" D Q:ACHSQUIT
- ..S ACHSTIEN=0 F S ACHSTIEN=$O(^ACHSF(DUZ(2),"PDOS",ACHSBDT1,ACHSDIEN,ACHSTIEN)) Q:(ACHSTIEN=ACHSTIEN+1)!(ACHSTIEN="")
- ..D TRNS2
- E F S ACHSBDT1=$O(^ACHSF(DUZ(2),"ES",ACHSBDT1)) Q:(ACHSBDT1>ACHSEDT)!(ACHSBDT1="") D Q:ACHSQUIT
- .S ACHSDIEN=0 F S ACHSDIEN=$O(^ACHSF(DUZ(2),"ES",ACHSBDT1,ACHSDIEN)) Q:ACHSDIEN="" D TRNS2 Q:ACHSQUIT
- I '$D(ZTSK),'ACHSQUIT D RTRN^ACHS
- G EXT
- ;
- TRNS2 ;
- S (ACHSPAT,ACHSDOS,ACHSORDT,ACHSCLRK)=""
- S ACHSREC=^ACHSF(DUZ(2),"D",ACHSDIEN,0)
- S ACHSDOC=$P(ACHSREC,"^",14)_"-"_$P(ACHSREC,"^",1)
- I $P(ACHSREC,"^",22)="" S ACHSPAT="NONE SPECIFIED"
- E S ACHSPAT=$E($P(^DPT($P(ACHSREC,"^",22),0),"^",1),1,23)
- S ACHSORDT=$$FMTE^XLFDT($P(ACHSREC,"^",2),"2D")
- S ACHSCLRK=$E($P(^VA(200,($P(ACHSREC,"^",18)),0),"^",1),1,15)
- I ACHSRPT1=1 S ACHSDOS=$$FMTE^XLFDT($P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHSTIEN,0)),"^",10),"2D")
- E S ACHSDOS=$$FMTE^XLFDT($P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,3)),"^",9),"2D")
- D PRINT
- Q
- PRINT ;
- I '$D(ZTSK),$Y>ACHSBM D RTRN^ACHS Q:$D(DUOUT)!$D(DTOUT) D HDR
- I ACHSPG=0 D HDR
- W !,ACHSDOC,?10,ACHSPAT,?36,ACHSDOS,?48,ACHSORDT,?60,ACHSCLRK
- Q
- HDR ;
- S ACHSPG=ACHSPG+1
- W @IOF
- I ACHSRPT=1 W !,"DOCUMENT LISTING BY PAID DATE OF SERVICE",?68,"PAGE: ",ACHSPG
- E W "DOCUMENT LISTING BY ESTIMATE DATE OF SERVICE",?68,"PAGE: ",ACHSPG
- W !!,"P.O. NO. PATIENT NAME "_$S(ACHSRPT=1:"ACT",1:"EST")_" D.O.S. DATE ISSUED ISSUED BY",!
- F I=1:1:76 W "-"
- Q
- EXT ;
- K ACHSREC,ACHSDIEN,ACHSTIEN,ACHSPAT,ACHSORDT,ACHSCLRK,ACHSBDT1,ACHSDOC,ACHSDOS
- K ACHSQUIT,ACHSRPT1,ACHSDOS
- D ERPT^ACHS
- Q
- H1 ;EP - From HELP^ACHS() via ^DIR.
- ;;@;!
- ;;Enter a '1' if you want Actual Date of Service to be listed.
- ;;Enter a '2' if you want Estimated Date of Service to be listed.
- ;;###
- ;
-
- ACHSRDOS ;IHS/OIT/FCJ - ESTIMATED DATE OF SERVICE REPORT FOR CHS [ 07/24/2000 10:57 AM ]
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001;Build 43
- +2 ;
- +3 SET ACHSIO=IO
- SET ACHSPG=0
- +4 DO BM^ACHSFU
- +5 WRITE !,"Report for Actual or Estimated DOS with Issue Date"
- DOCS ; Select type of docs to print.
- +1 SET ACHSRPT=$$DIR^XBDIR("S^1:Actual Date of Service;2:Estimated Date of Service","Print which documents","1","","","^D HELP^ACHS(""H1"",""ACHSRDOS"")",2)
- +2 IF $DATA(DUOUT)!$DATA(DTOUT)
- GOTO EXT
- +3 SET ACHSRPT1=$SELECT(ACHSRPT=1:"Actual Date of Service",1:"Estimated Date of Service")
- BDT ; Enter beginning date.
- +1 SET ACHSBDT=$$DATE^ACHS("B",ACHSRPT1,"")
- +2 IF $DATA(DUOUT)!$DATA(DTOUT)!(ACHSBDT<1)
- GOTO EXT
- EDT ; Enter the ending date.
- +1 SET ACHSEDT=$$DATE^ACHS("E",ACHSRPT1,"")
- +2 IF $DATA(DUOUT)
- GOTO BDT
- IF $DATA(DTOUT)!(ACHSEDT<1)
- GOTO EXT
- IF $$EBB^ACHS(ACHSBDT,ACHSEDT)
- GOTO EDT
- DEV ; Select device for report.
- +1 WRITE !
- +2 SET %=$$PB^ACHS
- +3 IF %=U!$DATA(DTOUT)!$DATA(DUOUT)
- DO EXT
- QUIT
- +4 IF %="B"
- DO VIEWR^XBLM("TRNS^ACHSRDOS")
- DO EN^XBVK("VALM")
- DO EXT
- QUIT
- +5 KILL IOP,%ZIS
- +6 SET %ZIS="PQ"
- +7 DO ^%ZIS
- IF $DATA(IO("S"))
- DO SLV^ACHSFU
- +8 KILL %ZIS
- +9 IF POP
- WRITE !,*7,"No device specified."
- DO HOME^%ZIS
- GOTO EXT
- +10 IF '$DATA(IO("Q"))
- GOTO TRNS
- +11 KILL IO("Q")
- +12 IF $EXTRACT(IOST)'="P"
- WRITE *7,!,"Please queue to printers only."
- GOTO DEV
- +13 SET ZTIO=""
- SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
- SET ZTRTN="TRNS^ACHSRDOS"
- SET ZTDESC="CHS "_ACHSRPT1_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)
- +14 FOR %="ACHSQIO","ACHSBDT","ACHSRPT","ACHSEDT","ACHSRPT1"
- SET ZTSAVE(%)=""
- +15 DO ^%ZTLOAD
- +16 IF '$DATA(ZTSK)
- GOTO DEV
- +17 ;
- +18 ;end of interactive portion. The rest performed by Taskman
- +19 ;
- TRNS ;START OF TRANSACTIONS
- +1 WRITE !
- +2 SET ACHSQUIT=0
- SET ACHSBDT1=ACHSBDT-1
- +3 IF ACHSRPT=1
- FOR
- SET ACHSBDT1=$ORDER(^ACHSF(DUZ(2),"PDOS",ACHSBDT1))
- IF (ACHSBDT1>ACHSEDT)!(ACHSBDT1="")
- QUIT
- Begin DoDot:1
- +4 SET ACHSDIEN=0
- FOR
- SET ACHSDIEN=$ORDER(^ACHSF(DUZ(2),"PDOS",ACHSBDT1,ACHSDIEN))
- IF ACHSDIEN=""
- QUIT
- Begin DoDot:2
- +5 SET ACHSTIEN=0
- FOR
- SET ACHSTIEN=$ORDER(^ACHSF(DUZ(2),"PDOS",ACHSBDT1,ACHSDIEN,ACHSTIEN))
- IF (ACHSTIEN=ACHSTIEN+1)!(ACHSTIEN="")
- QUIT
- +6 DO TRNS2
- End DoDot:2
- IF ACHSQUIT
- QUIT
- End DoDot:1
- IF ACHSQUIT
- QUIT
- +7 IF '$TEST
- FOR
- SET ACHSBDT1=$ORDER(^ACHSF(DUZ(2),"ES",ACHSBDT1))
- IF (ACHSBDT1>ACHSEDT)!(ACHSBDT1="")
- QUIT
- Begin DoDot:1
- +8 SET ACHSDIEN=0
- FOR
- SET ACHSDIEN=$ORDER(^ACHSF(DUZ(2),"ES",ACHSBDT1,ACHSDIEN))
- IF ACHSDIEN=""
- QUIT
- DO TRNS2
- IF ACHSQUIT
- QUIT
- End DoDot:1
- IF ACHSQUIT
- QUIT
- +9 IF '$DATA(ZTSK)
- IF 'ACHSQUIT
- DO RTRN^ACHS
- +10 GOTO EXT
- +11 ;
- TRNS2 ;
- +1 SET (ACHSPAT,ACHSDOS,ACHSORDT,ACHSCLRK)=""
- +2 SET ACHSREC=^ACHSF(DUZ(2),"D",ACHSDIEN,0)
- +3 SET ACHSDOC=$PIECE(ACHSREC,"^",14)_"-"_$PIECE(ACHSREC,"^",1)
- +4 IF $PIECE(ACHSREC,"^",22)=""
- SET ACHSPAT="NONE SPECIFIED"
- +5 IF '$TEST
- SET ACHSPAT=$EXTRACT($PIECE(^DPT($PIECE(ACHSREC,"^",22),0),"^",1),1,23)
- +6 SET ACHSORDT=$$FMTE^XLFDT($PIECE(ACHSREC,"^",2),"2D")
- +7 SET ACHSCLRK=$EXTRACT($PIECE(^VA(200,($PIECE(ACHSREC,"^",18)),0),"^",1),1,15)
- +8 IF ACHSRPT1=1
- SET ACHSDOS=$$FMTE^XLFDT($PIECE($GET(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHSTIEN,0)),"^",10),"2D")
- +9 IF '$TEST
- SET ACHSDOS=$$FMTE^XLFDT($PIECE($GET(^ACHSF(DUZ(2),"D",ACHSDIEN,3)),"^",9),"2D")
- +10 DO PRINT
- +11 QUIT
- PRINT ;
- +1 IF '$DATA(ZTSK)
- IF $Y>ACHSBM
- DO RTRN^ACHS
- IF $DATA(DUOUT)!$DATA(DTOUT)
- QUIT
- DO HDR
- +2 IF ACHSPG=0
- DO HDR
- +3 WRITE !,ACHSDOC,?10,ACHSPAT,?36,ACHSDOS,?48,ACHSORDT,?60,ACHSCLRK
- +4 QUIT
- HDR ;
- +1 SET ACHSPG=ACHSPG+1
- +2 WRITE @IOF
- +3 IF ACHSRPT=1
- WRITE !,"DOCUMENT LISTING BY PAID DATE OF SERVICE",?68,"PAGE: ",ACHSPG
- +4 IF '$TEST
- WRITE "DOCUMENT LISTING BY ESTIMATE DATE OF SERVICE",?68,"PAGE: ",ACHSPG
- +5 WRITE !!,"P.O. NO. PATIENT NAME "_$SELECT(ACHSRPT=1:"ACT",1:"EST")_" D.O.S. DATE ISSUED ISSUED BY",!
- +6 FOR I=1:1:76
- WRITE "-"
- +7 QUIT
- EXT ;
- +1 KILL ACHSREC,ACHSDIEN,ACHSTIEN,ACHSPAT,ACHSORDT,ACHSCLRK,ACHSBDT1,ACHSDOC,ACHSDOS
- +2 KILL ACHSQUIT,ACHSRPT1,ACHSDOS
- +3 DO ERPT^ACHS
- +4 QUIT
- H1 ;EP - From HELP^ACHS() via ^DIR.
- +1 ;;@;!
- +2 ;;Enter a '1' if you want Actual Date of Service to be listed.
- +3 ;;Enter a '2' if you want Estimated Date of Service to be listed.
- +4 ;;###
- +5 ;
- +6
- ***** ERRORS & WARNINGS IN ACHSRDOS *****
- H1+6 W - Null line (no commands or comment).
