ECXPHAU.m

ECXPHAU ;ALB/JAM - Print Pharmacy Volume Edit Log (IVP,PRE,UDP) ; 11/2/06 8:54am

 ;;3.0;DSS EXTRACTS;**92,154**;Dec 22, 1997;Build 13

EN ;entry point from option

 ;Init variables and sort array

 N QFLG,SORT,ECXX,ECXNAM,ECSD,ECED

 ;

 S QFLG=0

 W !!,"This option prints a log of the changes made to the Pharmacy"

 W !,"Extracts: PRE, IVP, UDP or BCM",!

 ;

 ;Get Extract

 D EXTRT Q:QFLG

 ;Get sort

 D GETSORT Q:QFLG

 W !!,"** REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY **"

 D DTRNG Q:QFLG

 D PRINT

 Q

EXTRT ;Prompt for extract to report on

 N DIR,DIRUT

 S DIR(0)="SO^P:PRE;I:IVP;U:UDP;B:BCM" ;154

 S DIR("A")="Which extract log do you need?"

 D ^DIR I $D(DIRUT) S QFLG=1 Q

 S ECXX=Y,ECXNAM=Y(0)

 Q

GETSORT ;Prompt for sorting order for report

 N DIR,X,Y,DIRUT

 S DIR(0)="SO^1:USER NAME;2:DATE CHANGED"

 S DIR("A")="Select sort for Pharmacy Volume Edit Log",DIR("B")=1

 D ^DIR

 I $D(DIRUT) S QFLG=1 Q

 S SORT=Y

 Q

PRINT ;Print report using fileman EN1^DIP for IVP

 N L,DIR,DIC,DIA,FLDS,DHD,BY,FR,TO,DIOBEG,ECXFIL,PG,ECXFLG

 S ECXFIL=$S(ECXX="P":"727.81",ECXX="I":"727.819",ECXX="B":"727.833",1:"727.809"),ECXFLG=0 ;154

 S L=0,DIC="^DIA("_ECXFIL_",",DIOBEG="I $E(IOST,1,2)=""C-"" W @IOF"

 S FLDS=".04;L23,.02;C25;L20,.01;C47;L14,D EXTNOI^ECXPHAU;C62;L9,"

 S FLDS=FLDS_"1.1;C74;L15,2;C90;L19,3;C110;L15"

 S DHD="W ?0 D RPTHDR^ECXPHAU"

 I SORT=1 D

 .S BY=".04,.02",FR="A,"_ECSD,TO="Zz,"_ECED

 I SORT=2 D

 .S BY=".02,.04",FR=ECSD_",A",TO=ECED_",Zz"

 D EN1^DIP

 I 'ECXFLG,'$D(^DIA(ECXFIL)) D

 .W !,"NO RECORDS FOUND"

 .I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR

 Q

 ;

EXTNOI ;Extract Number

 I $G(X) W $P($G(^ECX(ECXFIL,+X,0)),"^",3)

 Q

RPTHDR ;report header

 N LN

 S PG=$G(PG)+1,ECXFLG=1

 W "PHARMACY VOLUME EDIT LOG FOR "_ECXNAM,?115,"Page ",PG,!

 W "Printed on ",$$HTE^XLFDT($H)," for ",ECSD," to ",ECED,!

 W "USER NAME",?24,"DATE/TIME CHANGED",?46,"SEQUENCE #",?61

 W "EXTRACT #",?73,"FIELD NAME",?89,"OLD VALUE",?109,"NEW VALUE",!

 S $P(LN,"-",130)="" W LN,!

 Q

DTRNG ;report date range

 N %DT,ECDT,X,Y

DTREP S %DT="AEX",%DT("A")="Starting with Date: ",%DT(0)="-NOW" D ^%DT

 I Y<0 S QFLG=1 Q

 S ECDT=Y,ECSD=$$FMTE^XLFDT(Y,2)

 S %DT="AEX",%DT("A")="Ending with Date: ",%DT(0)="-NOW" D ^%DT

 I Y<0 S QFLG=1 Q

 I Y<ECDT D  G DTREP

 .W !!,"The ending date cannot be earlier than the starting date.",!

 I $E(Y,1,5)'=$E(ECDT,1,5) D  G DTREP

 .W !!,"Beginning and ending dates must be in the same month and year.",!

 S ECED=$$FMTE^XLFDT(Y,2)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECXPHAU   2510     printed  Mar 13, 2025@20:58:04                                                                                                                                                                                                     Page 2

ECXPHAU   ;ALB/JAM - Print Pharmacy Volume Edit Log (IVP,PRE,UDP) ; 11/2/06 8:54am

 +1       ;;3.0;DSS EXTRACTS;**92,154**;Dec 22, 1997;Build 13

EN        ;entry point from option

 +1       ;Init variables and sort array

 +2        NEW QFLG,SORT,ECXX,ECXNAM,ECSD,ECED

 +3       ;

 +4        SET QFLG=0

 +5        WRITE !!,"This option prints a log of the changes made to the Pharmacy"

 +6        WRITE !,"Extracts: PRE, IVP, UDP or BCM",!

 +7       ;

 +8       ;Get Extract

 +9        DO EXTRT

           if QFLG

               QUIT 

 +10      ;Get sort

 +11       DO GETSORT

           if QFLG

               QUIT 

 +12       WRITE !!,"** REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY **"

 +13       DO DTRNG

           if QFLG

               QUIT 

 +14       DO PRINT

 +15       QUIT 

EXTRT     ;Prompt for extract to report on

 +1        NEW DIR,DIRUT

 +2       ;154

           SET DIR(0)="SO^P:PRE;I:IVP;U:UDP;B:BCM"

 +3        SET DIR("A")="Which extract log do you need?"

 +4        DO ^DIR

           IF $DATA(DIRUT)

               SET QFLG=1

               QUIT 

 +5        SET ECXX=Y

           SET ECXNAM=Y(0)

 +6        QUIT 

GETSORT   ;Prompt for sorting order for report

 +1        NEW DIR,X,Y,DIRUT

 +2        SET DIR(0)="SO^1:USER NAME;2:DATE CHANGED"

 +3        SET DIR("A")="Select sort for Pharmacy Volume Edit Log"

           SET DIR("B")=1

 +4        DO ^DIR

 +5        IF $DATA(DIRUT)

               SET QFLG=1

               QUIT 

 +6        SET SORT=Y

 +7        QUIT 

PRINT     ;Print report using fileman EN1^DIP for IVP

 +1        NEW L,DIR,DIC,DIA,FLDS,DHD,BY,FR,TO,DIOBEG,ECXFIL,PG,ECXFLG

 +2       ;154

           SET ECXFIL=$SELECT(ECXX="P":"727.81",ECXX="I":"727.819",ECXX="B":"727.833",1:"727.809")

           SET ECXFLG=0

 +3        SET L=0

           SET DIC="^DIA("_ECXFIL_","

           SET DIOBEG="I $E(IOST,1,2)=""C-"" W @IOF"

 +4        SET FLDS=".04;L23,.02;C25;L20,.01;C47;L14,D EXTNOI^ECXPHAU;C62;L9,"

 +5        SET FLDS=FLDS_"1.1;C74;L15,2;C90;L19,3;C110;L15"

 +6        SET DHD="W ?0 D RPTHDR^ECXPHAU"

 +7        IF SORT=1

               Begin DoDot:1

 +8                SET BY=".04,.02"

                   SET FR="A,"_ECSD

                   SET TO="Zz,"_ECED

               End DoDot:1

 +9        IF SORT=2

               Begin DoDot:1

 +10               SET BY=".02,.04"

                   SET FR=ECSD_",A"

                   SET TO=ECED_",Zz"

               End DoDot:1

 +11       DO EN1^DIP

 +12       IF 'ECXFLG

               IF '$DATA(^DIA(ECXFIL))

                   Begin DoDot:1

 +13                   WRITE !,"NO RECORDS FOUND"

 +14                   IF $EXTRACT(IOST,1,2)="C-"

                           SET DIR(0)="E"

                           DO ^DIR

                   End DoDot:1

 +15       QUIT 

 +16      ;

EXTNOI    ;Extract Number

 +1        IF $GET(X)

               WRITE $PIECE($GET(^ECX(ECXFIL,+X,0)),"^",3)

 +2        QUIT 

RPTHDR    ;report header

 +1        NEW LN

 +2        SET PG=$GET(PG)+1

           SET ECXFLG=1

 +3        WRITE "PHARMACY VOLUME EDIT LOG FOR "_ECXNAM,?115,"Page ",PG,!

 +4        WRITE "Printed on ",$$HTE^XLFDT($HOROLOG)," for ",ECSD," to ",ECED,!

 +5        WRITE "USER NAME",?24,"DATE/TIME CHANGED",?46,"SEQUENCE #",?61

 +6        WRITE "EXTRACT #",?73,"FIELD NAME",?89,"OLD VALUE",?109,"NEW VALUE",!

 +7        SET $PIECE(LN,"-",130)=""

           WRITE LN,!

 +8        QUIT 

DTRNG     ;report date range

 +1        NEW %DT,ECDT,X,Y

DTREP      SET %DT="AEX"

           SET %DT("A")="Starting with Date: "

           SET %DT(0)="-NOW"

           DO ^%DT

 +1        IF Y<0

               SET QFLG=1

               QUIT 

 +2        SET ECDT=Y

           SET ECSD=$$FMTE^XLFDT(Y,2)

 +3        SET %DT="AEX"

           SET %DT("A")="Ending with Date: "

           SET %DT(0)="-NOW"

           DO ^%DT

 +4        IF Y<0

               SET QFLG=1

               QUIT 

 +5        IF Y<ECDT

               Begin DoDot:1

 +6                WRITE !!,"The ending date cannot be earlier than the starting date.",!

               End DoDot:1

               GOTO DTREP

 +7        IF $EXTRACT(Y,1,5)'=$EXTRACT(ECDT,1,5)

               Begin DoDot:1

 +8                WRITE !!,"Beginning and ending dates must be in the same month and year.",!

               End DoDot:1

               GOTO DTREP

 +9        SET ECED=$$FMTE^XLFDT(Y,2)

 +10       QUIT