ACHSSIGB ;IHS/ITSC/JVK -PROGRAM TO LIST UNSIGNED PO'S WAITING FOR E-SIG [ 01/11/2005 7:31 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**7**;JUN 11,2001
;;ACHS*3.1*7 - NEW ROUTINE PENDING E-SIG REPORT
;;CALLED BY ACHSESIGRPT
;
TITLE ;;PENDING E-SIG
S ACHSIO=IO
S ACHSCNT=0
K X2,X3
BDT ;--ASK THE DATE RANGE--
;S ACHSBDT=$$DATE^ACHS("B",$P($T(TITLE),";",3),"ISSUE")
;G K:$D(DUOUT)!$D(DTOUT)!(ACHSBDT<1)
DEV ;
S %=$$PB^ACHS
I %=U!$D(DTOUT)!$D(DUOUT) D K Q
I %="B" D VIEWR^XBLM("PRINT^ACHSSIGB"),EN^XBVK("VALM"),K Q
S %ZIS="OPQ"
D ^%ZIS
I POP D HOME^%ZIS G K
G:'$D(IO("Q")) PRINT
K IO("Q")
I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
;ITSC/SET/JVK ACHS*3.1*12
;S ZTRTN="PRINT^ACHSDST",ZTIO="",ZTDESC=$P($T(TITLE),";",3)_", Type "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT),ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
S ZTRTN="PRINT^ACHSSIGB",ZTIO="",ZTDESC=$P($T(TITLE),";",3)_", Type "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT),ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
F ACHS="ACHSQIO","ACHSBDT" S ZTSAVE(ACHS)=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
K ;
K ACHS,ACHSIO,ACHSQIO,ACHSBDT,ACHSRPT,ZTIO,ZTSK
D ^%ZISC
Q
PRINT ;
D FC^ACHSUF
I $D(ACHSERR),ACHSERR=1 K ZTSK G KILL
D BRPT^ACHSFU
S ACHST1=$$C^XBFUNC("Purchase Orders Pending for Electronic Signature",80)
S ACHST2=$$C^XBFUNC("Run date of "_$$FMTE^XLFDT(DT),80)
D HDR
S X3=0
LOOP1 ;--LOOP THRU THE ^ACHS("EQ",DUZ(2),ACHSTYP) CROSS REFERENCE--
F ACHSTYP=1,3,2 D Q:+ACHSTYP=0
.D LOOP2
G END
;Q
LOOP2 ;--LOOP TO GET DOC NUMBER--
S DA=0
F S DA=$O(^ACHSF("EQ",DUZ(2),ACHSTYP,DA)) Q:+DA=0 D
.S ACHSTEST=$P(^ACHSF(DUZ(2),"D",DA,0),U,24)
.I 'ACHSTEST D DATAFLD
Q
DATAFLD ;--GET THE DATA FIELDS FOR THE REPORT --
S ACHSDOC1=$P($G(^ACHSF(DUZ(2),"D",DA,0)),U),ACHSDOC2=$P(^(0),U,14)
S ACHSVPTR=$P(^ACHSF(DUZ(2),"D",DA,0),U,8)
S ACHSIDT=$P(^ACHSF(DUZ(2),"D",DA,0),U,2)
S ACHS("$")=$J($FN($P(^ACHSF(DUZ(2),"D",DA,0),U,9),",",2),8)
S ACHSVTYP=$S(ACHSTYP=1:"Hospital",ACHSTYP=3:"Outpatient",ACHSTYP=2:"Dental",1:"")
I $D(^AUTTVNDR(ACHSVPTR,0)) S ACHSVNDR=$P(^(0),U)
S ACHSDOC=ACHSDOC2_"-"_ACHSFC_"-"_ACHSDOC1
W ACHSDOC,?20,$E(ACHSVNDR,1,26),?48,$E(ACHSIDT,4,7),$E(ACHSIDT,2,3),?60,ACHS("$"),?70,ACHSVTYP,!
S ACHSCNT=ACHSCNT+1
Q
HDR ;
S ACHSPG=ACHSPG+1
W @IOF,!!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,$$C^XBFUNC("*** CONTRACT HEALTH MANNAGEMENT SYSTEM ***",80),!!,ACHSLOC,!?22,"PENDING ELECTRONIC SIGNATURE REPORT"
I $D(ZTQUEUED) W ?77-$L(ZTSK),"(",ZTSK,")"
W !,ACHSTIME,!,ACHST1,!,ACHST2,!!,"Document Number",?20,"Provider of Service",?45,"Issue Date",?58,"Obligation Amt.",?74,"Type",!,$$REPEAT^XLFSTR("=",79),!
Q
END ;
W !,$$REPEAT^XLFSTR("-",79),!
W "Total Documents: ",ACHSCNT,!
D RTRN^ACHS
W @IOF
KILL ;
I $D(ZTQUEUED) K ACHSFC
D ERPT^ACHS
K ACHSDOC,ACHSDOC1,ACHSDOC2,ACHSIDT,ACHSVNDR,ACHSCNT
K DA,DFN,X2,X3
Q
ACHSSIGB ;IHS/ITSC/JVK -PROGRAM TO LIST UNSIGNED PO'S WAITING FOR E-SIG [ 01/11/2005 7:31 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**7**;JUN 11,2001
+2 ;;ACHS*3.1*7 - NEW ROUTINE PENDING E-SIG REPORT
+3 ;;CALLED BY ACHSESIGRPT
+4 ;
TITLE ;;PENDING E-SIG
+1 SET ACHSIO=IO
+2 SET ACHSCNT=0
+3 KILL X2,X3
BDT ;--ASK THE DATE RANGE--
+1 ;S ACHSBDT=$$DATE^ACHS("B",$P($T(TITLE),";",3),"ISSUE")
+2 ;G K:$D(DUOUT)!$D(DTOUT)!(ACHSBDT<1)
DEV ;
+1 SET %=$$PB^ACHS
+2 IF %=U!$DATA(DTOUT)!$DATA(DUOUT)
DO K
QUIT
+3 IF %="B"
DO VIEWR^XBLM("PRINT^ACHSSIGB")
DO EN^XBVK("VALM")
DO K
QUIT
+4 SET %ZIS="OPQ"
+5 DO ^%ZIS
+6 IF POP
DO HOME^%ZIS
GOTO K
+7 IF '$DATA(IO("Q"))
GOTO PRINT
+8 KILL IO("Q")
+9 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+10 ;ITSC/SET/JVK ACHS*3.1*12
+11 ;S ZTRTN="PRINT^ACHSDST",ZTIO="",ZTDESC=$P($T(TITLE),";",3)_", Type "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT),ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
+12 SET ZTRTN="PRINT^ACHSSIGB"
SET ZTIO=""
SET ZTDESC=$PIECE($TEXT(TITLE),";",3)_", Type "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)
SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
+13 FOR ACHS="ACHSQIO","ACHSBDT"
SET ZTSAVE(ACHS)=""
+14 DO ^%ZTLOAD
+15 IF '$DATA(ZTSK)
GOTO DEV
K ;
+1 KILL ACHS,ACHSIO,ACHSQIO,ACHSBDT,ACHSRPT,ZTIO,ZTSK
+2 DO ^%ZISC
+3 QUIT
PRINT ;
+1 DO FC^ACHSUF
+2 IF $DATA(ACHSERR)
IF ACHSERR=1
KILL ZTSK
GOTO KILL
+3 DO BRPT^ACHSFU
+4 SET ACHST1=$$C^XBFUNC("Purchase Orders Pending for Electronic Signature",80)
+5 SET ACHST2=$$C^XBFUNC("Run date of "_$$FMTE^XLFDT(DT),80)
+6 DO HDR
+7 SET X3=0
LOOP1 ;--LOOP THRU THE ^ACHS("EQ",DUZ(2),ACHSTYP) CROSS REFERENCE--
+1 FOR ACHSTYP=1,3,2
Begin DoDot:1
+2 DO LOOP2
End DoDot:1
IF +ACHSTYP=0
QUIT
+3 GOTO END
+4 ;Q
LOOP2 ;--LOOP TO GET DOC NUMBER--
+1 SET DA=0
+2 FOR
SET DA=$ORDER(^ACHSF("EQ",DUZ(2),ACHSTYP,DA))
IF +DA=0
QUIT
Begin DoDot:1
+3 SET ACHSTEST=$PIECE(^ACHSF(DUZ(2),"D",DA,0),U,24)
+4 IF 'ACHSTEST
DO DATAFLD
End DoDot:1
+5 QUIT
DATAFLD ;--GET THE DATA FIELDS FOR THE REPORT --
+1 SET ACHSDOC1=$PIECE($GET(^ACHSF(DUZ(2),"D",DA,0)),U)
SET ACHSDOC2=$PIECE(^(0),U,14)
+2 SET ACHSVPTR=$PIECE(^ACHSF(DUZ(2),"D",DA,0),U,8)
+3 SET ACHSIDT=$PIECE(^ACHSF(DUZ(2),"D",DA,0),U,2)
+4 SET ACHS("$")=$JUSTIFY($FNUMBER($PIECE(^ACHSF(DUZ(2),"D",DA,0),U,9),",",2),8)
+5 SET ACHSVTYP=$SELECT(ACHSTYP=1:"Hospital",ACHSTYP=3:"Outpatient",ACHSTYP=2:"Dental",1:"")
+6 IF $DATA(^AUTTVNDR(ACHSVPTR,0))
SET ACHSVNDR=$PIECE(^(0),U)
+7 SET ACHSDOC=ACHSDOC2_"-"_ACHSFC_"-"_ACHSDOC1
+8 WRITE ACHSDOC,?20,$EXTRACT(ACHSVNDR,1,26),?48,$EXTRACT(ACHSIDT,4,7),$EXTRACT(ACHSIDT,2,3),?60,ACHS("$"),?70,ACHSVTYP,!
+9 SET ACHSCNT=ACHSCNT+1
+10 QUIT
HDR ;
+1 SET ACHSPG=ACHSPG+1
+2 WRITE @IOF,!!,ACHSUSR,?71,"Page",$JUSTIFY(ACHSPG,3),!,$$C^XBFUNC("*** CONTRACT HEALTH MANNAGEMENT SYSTEM ***",80),!!,ACHSLOC,!?22,"PENDING ELECTRONIC SIGNATURE REPORT"
+3 IF $DATA(ZTQUEUED)
WRITE ?77-$LENGTH(ZTSK),"(",ZTSK,")"
+4 WRITE !,ACHSTIME,!,ACHST1,!,ACHST2,!!,"Document Number",?20,"Provider of Service",?45,"Issue Date",?58,"Obligation Amt.",?74,"Type",!,$$REPEAT^XLFSTR("=",79),!
+5 QUIT
END ;
+1 WRITE !,$$REPEAT^XLFSTR("-",79),!
+2 WRITE "Total Documents: ",ACHSCNT,!
+3 DO RTRN^ACHS
+4 WRITE @IOF
KILL ;
+1 IF $DATA(ZTQUEUED)
KILL ACHSFC
+2 DO ERPT^ACHS
+3 KILL ACHSDOC,ACHSDOC1,ACHSDOC2,ACHSIDT,ACHSVNDR,ACHSCNT
+4 KILL DA,DFN,X2,X3
+5 QUIT
