ENTIRRX ;WOIFO/SAB - Signature Exception Report ;2/4/2008
;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,ENADT,ENTYP,X,Y
;
; ask type
S DIR(0)="S^E:ELECTRONICALLY SIGNED;C:CERTIFIED HARD COPY SIGNATURE;B:BOTH"
S DIR("A")="Select type of signature to check"
S DIR("B")="BOTH"
D ^DIR K DIR Q:$D(DIRUT)
S ENTYP=Y
;
; ask anniversary date
S DIR(0)="D"
S DIR("A")="Report signatures at least 1 year old as of "
S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-1))
D ^DIR K DIR Q:$D(DIRUT)
S ENADT=Y
;
; ask device
S %ZIS="Q" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="QEN^ENTIRRX",ZTDESC="Signature Exception Report"
. S ZTSAVE("ENTYP")="",ZTSAVE("ENADT")=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK,IO("Q")
;
QEN ; queued entry
U IO
;
; generate output
K ENT S ENT=0
S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDT=Y
S ENCDT=($E(ENADT,1,3)-1)_$E(ENADT,4,7) ; computed date (1 year before)
S ENADTE=$$FMTE^XLFDT(ENADT) ; external format for anniversary date
D HD
;
; print data
; loop thru active assignments by owner and equipment
S ENOWN=0 F S ENOWN=$O(^ENG(6916.3,"AOA",ENOWN)) Q:'ENOWN D Q:END
. S ENEQ=0 F S ENEQ=$O(^ENG(6916.3,"AOA",ENOWN,ENEQ)) Q:'ENEQ D Q:END
. . S ENDA=0
. . F S ENDA=$O(^ENG(6916.3,"AOA",ENOWN,ENEQ,ENDA)) Q:'ENDA D Q:END
. . . S ENY=$G(^ENG(6916.3,ENDA,0))
. . . Q:$P(ENY,U,5)="" ; not signed
. . . I ENTYP="E",$P(ENY,U,7)'="" Q ; only check e-sigs
. . . I ENTYP="C",$P(ENY,U,7)="" Q ; only check certified sigs
. . . Q:$P($P(ENY,U,5),".")>ENCDT ; was signed after computed date
. . . ;
. . . ; report assignment
. . . S ENT=ENT+1
. . . ;
. . . ; display assignment data
. . . I $Y+6>IOSL D HD Q:END
. . . W !,$$GET1^DIQ(6916.3,ENDA,1)
. . . W ?32,ENEQ
. . . W ?44,$$GET1^DIQ(6916.3,ENDA,20)
. . . W ?55,$$GET1^DIQ(6916.3,ENDA,21)
. . . W !," ",$E($$GET1^DIQ(6914,ENEQ,3),1,76)
;
I 'END D
. ; report footer
. I $Y+4>IOSL D HD Q:END
. W !!,"Count of signatures on report = ",ENT
. I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
;
D ^%ZISC
;
EXIT I $D(ZTQUEUED) S ZTREQ="@"
K DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,POP,X,Y
K ENADT,ENADTE,ENCDT,ENDA,ENEQ,ENOWN,ENT,ENTYP,ENY
K END,ENDT,ENPG
Q
;
HD ; header
I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
I $E(IOST,1,2)="C-"!ENPG W @IOF
S ENPG=ENPG+1
W "SIGNATURE EXCEPTION REPORT",?48,ENDT,?72,"page ",ENPG,!
W " for "
I ENTYP="E" W "electronic "
I ENTYP="C" W "hard copy "
W "signatures at least one year old as of ",ENADTE,!!
W "Owner",?32,"Entry #",?44,"Status",?55,"Status Date",!
W "------------------------------",?32,"----------"
W ?44,"---------",?55,"-----------"
Q
;
;ENTIRRX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENTIRRX 2787 printed Apr 09, 2024@21:02 Page 2
ENTIRRX ;WOIFO/SAB - Signature Exception Report ;2/4/2008
+1 ;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
+2 ;
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,ENADT,ENTYP,X,Y
+4 ;
+5 ; ask type
+6 SET DIR(0)="S^E:ELECTRONICALLY SIGNED;C:CERTIFIED HARD COPY SIGNATURE;B:BOTH"
+7 SET DIR("A")="Select type of signature to check"
+8 SET DIR("B")="BOTH"
+9 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+10 SET ENTYP=Y
+11 ;
+12 ; ask anniversary date
+13 SET DIR(0)="D"
+14 SET DIR("A")="Report signatures at least 1 year old as of "
+15 SET DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-1))
+16 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+17 SET ENADT=Y
+18 ;
+19 ; ask device
+20 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+21 IF $DATA(IO("Q"))
Begin DoDot:1
+22 SET ZTRTN="QEN^ENTIRRX"
SET ZTDESC="Signature Exception Report"
+23 SET ZTSAVE("ENTYP")=""
SET ZTSAVE("ENADT")=""
+24 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK,IO("Q")
End DoDot:1
GOTO EXIT
+25 ;
QEN ; queued entry
+1 USE IO
+2 ;
+3 ; generate output
+4 KILL ENT
SET ENT=0
+5 SET (END,ENPG)=0
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET ENDT=Y
+6 ; computed date (1 year before)
SET ENCDT=($EXTRACT(ENADT,1,3)-1)_$EXTRACT(ENADT,4,7)
+7 ; external format for anniversary date
SET ENADTE=$$FMTE^XLFDT(ENADT)
+8 DO HD
+9 ;
+10 ; print data
+11 ; loop thru active assignments by owner and equipment
+12 SET ENOWN=0
FOR
SET ENOWN=$ORDER(^ENG(6916.3,"AOA",ENOWN))
if 'ENOWN
QUIT
Begin DoDot:1
+13 SET ENEQ=0
FOR
SET ENEQ=$ORDER(^ENG(6916.3,"AOA",ENOWN,ENEQ))
if 'ENEQ
QUIT
Begin DoDot:2
+14 SET ENDA=0
+15 FOR
SET ENDA=$ORDER(^ENG(6916.3,"AOA",ENOWN,ENEQ,ENDA))
if 'ENDA
QUIT
Begin DoDot:3
+16 SET ENY=$GET(^ENG(6916.3,ENDA,0))
+17 ; not signed
if $PIECE(ENY,U,5)=""
QUIT
+18 ; only check e-sigs
IF ENTYP="E"
IF $PIECE(ENY,U,7)'=""
QUIT
+19 ; only check certified sigs
IF ENTYP="C"
IF $PIECE(ENY,U,7)=""
QUIT
+20 ; was signed after computed date
if $PIECE($PIECE(ENY,U,5),".")>ENCDT
QUIT
+21 ;
+22 ; report assignment
+23 SET ENT=ENT+1
+24 ;
+25 ; display assignment data
+26 IF $Y+6>IOSL
DO HD
if END
QUIT
+27 WRITE !,$$GET1^DIQ(6916.3,ENDA,1)
+28 WRITE ?32,ENEQ
+29 WRITE ?44,$$GET1^DIQ(6916.3,ENDA,20)
+30 WRITE ?55,$$GET1^DIQ(6916.3,ENDA,21)
+31 WRITE !," ",$EXTRACT($$GET1^DIQ(6914,ENEQ,3),1,76)
End DoDot:3
if END
QUIT
End DoDot:2
if END
QUIT
End DoDot:1
if END
QUIT
+32 ;
+33 IF 'END
Begin DoDot:1
+34 ; report footer
+35 IF $Y+4>IOSL
DO HD
if END
QUIT
+36 WRITE !!,"Count of signatures on report = ",ENT
+37 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+38 ;
+39 DO ^%ZISC
+40 ;
EXIT IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 KILL DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,POP,X,Y
+2 KILL ENADT,ENADTE,ENCDT,ENDA,ENEQ,ENOWN,ENT,ENTYP,ENY
+3 KILL END,ENDT,ENPG
+4 QUIT
+5 ;
HD ; header
+1 IF $EXTRACT(IOST,1,2)="C-"
IF ENPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET END=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"!ENPG
WRITE @IOF
+3 SET ENPG=ENPG+1
+4 WRITE "SIGNATURE EXCEPTION REPORT",?48,ENDT,?72,"page ",ENPG,!
+5 WRITE " for "
+6 IF ENTYP="E"
WRITE "electronic "
+7 IF ENTYP="C"
WRITE "hard copy "
+8 WRITE "signatures at least one year old as of ",ENADTE,!!
+9 WRITE "Owner",?32,"Entry #",?44,"Status",?55,"Status Date",!
+10 WRITE "------------------------------",?32,"----------"
+11 WRITE ?44,"---------",?55,"-----------"
+12 QUIT
+13 ;
+14 ;ENTIRRX
