SD44AUDI ;ALB/DHE - Audit print of file 44 fields ;12/8/10 10:17
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30
EN ;entry point from option
;Init variables and sort array
N QFLG,SORT,SDX,SDNAM,SDSD,SDED,SDDT,SDNAME,SDST,SDSEQ,STCODE,D0
;
S QFLG=0
W !!,"This option prints a log of the changes made to Clinic Locations"
;
;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 Clinic 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
N L,DIR,DIC,DIA,FLDS,DHD,BY,FR,TO,DIOBEG,SDFIL,PG,SDFLG
S SDFIL=44,SDFLG=0
S L=0,DIC="^DIA("_SDFIL_",",DIOBEG="I $E(IOST,1,2)=""C-"" W @IOF"
S FLDS=".04;L23,.02;C25;L20,.01;C47;L10,D CLINM^SD44AUDI;C59;L18,"
S FLDS=FLDS_"1.1;C79;L10,D STCODE^SD44AUDI(2);C90;L19,D STCODE^SD44AUDI(3);C110;L15"
S DHD="W ?0 D RPTHDR^SD44AUDI"
I SORT=1 D
.S BY=".04,.02",FR="A,"_SDSD,TO="Zz,"_SDED
I SORT=2 D
.S BY=".02,.04",FR=SDSD_",A",TO=SDED_",Zz"
D EN1^DIP
I 'SDFLG,'$D(^DIA(SDFIL)) D
.W !,"NO RECORDS FOUND"
.I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR
Q
;
CLINM ;Clinic name
I $G(X) D
. W $E($P($G(^SC(+X,0)),"^"),1,18)
Q
SEQ ;retain sequence number
S SDST=0 I $G(D0) D
. S SDSEQ=D0
. I $D(^DIA(44,SDSEQ,0)) D
. I $P(^DIA(44,SDSEQ,0),"^",3)=8!($P(^(0),"^",3)=2503) D
. . S SDST=1
Q
STCODE(FLD) ;Get AMIS Stop Code #
D SEQ
D
. I '$D(^DIA(44,D0,FLD)) S STCODE="" Q
. I SDST=1 D
. . S STCODE=$S(FLD=2:$P($G(^DIA(44,D0,2.1)),U),1:$P($G(^DIA(44,D0,3.1)),U))
. . I $D(^DIC(40.7,+STCODE,0)) S STCODE=$P(^DIC(40.7,STCODE,0),"^",2)
. . ;if stcode name has been changed then just print free txt
. . I STCODE="" S STCODE=^DIA(44,D0,FLD)
. . W $E(STCODE,1,18)
. E D
. . W $E(^DIA(44,D0,FLD),1,18)
Q
RPTHDR ;report header
N LN
S PG=$G(PG)+1,SDFLG=1
W "CLINIC EDIT LOG ",?115,"Page ",PG,!
W "Printed on ",$$HTE^XLFDT($H)," for ",SDSD," to ",SDED,!
W "USER NAME",?24,"DATE/TIME CHANGED",?46,"CLINIC IEN",?58
W "CLINIC NAME",?78,"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 SDDT=Y,SDSD=$$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<SDDT D G DTREP
.W !!,"The ending date cannot be earlier than the starting date.",!
I $E(Y,1,5)'=$E(SDDT,1,5) D G DTREP
.W !!,"Beginning and ending dates must be in the same month and year.",!
S SDED=$$FMTE^XLFDT(Y,2)
Q
SD44AUDI ;ALB/DHE - Audit print of file 44 fields ;12/8/10 10:17
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
+2 ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30
EN ;entry point from option
+1 ;Init variables and sort array
+2 NEW QFLG,SORT,SDX,SDNAM,SDSD,SDED,SDDT,SDNAME,SDST,SDSEQ,STCODE,D0
+3 ;
+4 SET QFLG=0
+5 WRITE !!,"This option prints a log of the changes made to Clinic Locations"
+6 ;
+7 ;Get sort
+8 DO GETSORT
IF QFLG
QUIT
+9 WRITE !!,"** REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY **"
+10 DO DTRNG
IF QFLG
QUIT
+11 DO PRINT
+12 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 Clinic 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
+1 NEW L,DIR,DIC,DIA,FLDS,DHD,BY,FR,TO,DIOBEG,SDFIL,PG,SDFLG
+2 SET SDFIL=44
SET SDFLG=0
+3 SET L=0
SET DIC="^DIA("_SDFIL_","
SET DIOBEG="I $E(IOST,1,2)=""C-"" W @IOF"
+4 SET FLDS=".04;L23,.02;C25;L20,.01;C47;L10,D CLINM^SD44AUDI;C59;L18,"
+5 SET FLDS=FLDS_"1.1;C79;L10,D STCODE^SD44AUDI(2);C90;L19,D STCODE^SD44AUDI(3);C110;L15"
+6 SET DHD="W ?0 D RPTHDR^SD44AUDI"
+7 IF SORT=1
Begin DoDot:1
+8 SET BY=".04,.02"
SET FR="A,"_SDSD
SET TO="Zz,"_SDED
End DoDot:1
+9 IF SORT=2
Begin DoDot:1
+10 SET BY=".02,.04"
SET FR=SDSD_",A"
SET TO=SDED_",Zz"
End DoDot:1
+11 DO EN1^DIP
+12 IF 'SDFLG
IF '$DATA(^DIA(SDFIL))
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 ;
CLINM ;Clinic name
+1 IF $GET(X)
Begin DoDot:1
+2 WRITE $EXTRACT($PIECE($GET(^SC(+X,0)),"^"),1,18)
End DoDot:1
+3 QUIT
SEQ ;retain sequence number
+1 SET SDST=0
IF $GET(D0)
Begin DoDot:1
+2 SET SDSEQ=D0
+3 IF $DATA(^DIA(44,SDSEQ,0))
Begin DoDot:2
End DoDot:2
+4 IF $PIECE(^DIA(44,SDSEQ,0),"^",3)=8!($PIECE(^(0),"^",3)=2503)
Begin DoDot:2
+5 SET SDST=1
End DoDot:2
End DoDot:1
+6 QUIT
STCODE(FLD) ;Get AMIS Stop Code #
+1 DO SEQ
+2 Begin DoDot:1
+3 IF '$DATA(^DIA(44,D0,FLD))
SET STCODE=""
QUIT
+4 IF SDST=1
Begin DoDot:2
+5 SET STCODE=$SELECT(FLD=2:$PIECE($GET(^DIA(44,D0,2.1)),U),1:$PIECE($GET(^DIA(44,D0,3.1)),U))
+6 IF $DATA(^DIC(40.7,+STCODE,0))
SET STCODE=$PIECE(^DIC(40.7,STCODE,0),"^",2)
+7 ;if stcode name has been changed then just print free txt
+8 IF STCODE=""
SET STCODE=^DIA(44,D0,FLD)
+9 WRITE $EXTRACT(STCODE,1,18)
End DoDot:2
+10 IF '$TEST
Begin DoDot:2
+11 WRITE $EXTRACT(^DIA(44,D0,FLD),1,18)
End DoDot:2
End DoDot:1
+12 QUIT
RPTHDR ;report header
+1 NEW LN
+2 SET PG=$GET(PG)+1
SET SDFLG=1
+3 WRITE "CLINIC EDIT LOG ",?115,"Page ",PG,!
+4 WRITE "Printed on ",$$HTE^XLFDT($HOROLOG)," for ",SDSD," to ",SDED,!
+5 WRITE "USER NAME",?24,"DATE/TIME CHANGED",?46,"CLINIC IEN",?58
+6 WRITE "CLINIC NAME",?78,"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 SDDT=Y
SET SDSD=$$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<SDDT
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(SDDT,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 SDED=$$FMTE^XLFDT(Y,2)
+10 QUIT
