ECXPROEL ;ALB/DAN - Print Prosthetics Extract Edit Log; 11/2/06 8:54am ;4/5/16 12:53
;;3.0;DSS EXTRACTS;**161**;Dec 22, 1997;Build 6
EN ;entry point from option
;Init variables and sort array
N QFLG,SORT,ECSD,ECED
;
S QFLG=0
W !!,"This option prints a log of the changes made to the Prosthetics"
W !,"Extracts.",!
;
;Get sort
D GETSORT Q:QFLG
W !!,"** REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY **"
D DTRNG Q:QFLG
D PRINT
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 Prosthetics Extract 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=727.826,ECXFLG=0
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^ECXPROEL;C62;L9,"
S FLDS=FLDS_"1.1;C74;L15,2;C90;L19,3;C110;L15"
S DHD="W ?0 D RPTHDR^ECXPROEL"
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 "PROSTHETICS EXTRACT EDIT LOG",?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 ---[H[J[2J[HECXPROEL 2174 printed Apr 09, 2024@20:56:10 Page 2
ECXPROEL ;ALB/DAN - Print Prosthetics Extract Edit Log; 11/2/06 8:54am ;4/5/16 12:53
+1 ;;3.0;DSS EXTRACTS;**161**;Dec 22, 1997;Build 6
EN ;entry point from option
+1 ;Init variables and sort array
+2 NEW QFLG,SORT,ECSD,ECED
+3 ;
+4 SET QFLG=0
+5 WRITE !!,"This option prints a log of the changes made to the Prosthetics"
+6 WRITE !,"Extracts.",!
+7 ;
+8 ;Get sort
+9 DO GETSORT
if QFLG
QUIT
+10 WRITE !!,"** REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY **"
+11 DO DTRNG
if QFLG
QUIT
+12 DO PRINT
+13 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 Prosthetics Extract 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 SET ECXFIL=727.826
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^ECXPROEL;C62;L9,"
+5 SET FLDS=FLDS_"1.1;C74;L15,2;C90;L19,3;C110;L15"
+6 SET DHD="W ?0 D RPTHDR^ECXPROEL"
+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 "PROSTHETICS EXTRACT EDIT LOG",?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
