ENTIRRX.m

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 ---ENTIRRX   2787     printed  Mar 13, 2025@21:00:38                                                                                                                                                                                                     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