ACHSSIGB.m

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