Routine: TIUSUPN

TIUSUPN ;;SLC/TT - TIU SIGNED/UNSIGNED List Manager ; 04-FEB-2005

 ;;1.0;TEXT INTEGRATION UTILITIES;**180**;Jun 20, 1997

EN ; -- main entry point for TIU SIGNED/UNSIGNED PN

 N TIUSDT,TIUEDT

 W @IOF

 K ^TMP("TIUPS180",$J),^TMP("TIUSEL",$J),^TMP("VALMAR",$J),^TMP("TIU180",$J)

 I '$$ASKRNG(.TIUSDT,.TIUEDT) Q

 D EN^VALM("TIU SIGNED/UNSIGNED")

HDR ; -- header code

 N HDR1,HDR2

 S HDR1="From "_$$FMTE^XLFDT(TIUSDT)_" to "_$$FMTE^XLFDT(TIUEDT,"D")

 S HDR2=$P(^TMP("TIU180",$J,"TOTAL"),U)_" "_$S($P(^TMP("TIU180",$J,"TOTAL"),U)=0:"Document",$P(^TMP("TIU180",$J,"TOTAL"),U)=1:"Document",1:"Documents")

 S VALMHDR(1)=$$SETSTR^VALM1(HDR1,"",(IOM-$L(HDR1))/2,$L(HDR1))

 S VALMHDR(2)=$$SETSTR^VALM1(HDR2,"",(IOM-$L(HDR2))/2,$L(HDR2))

 D XQORM

INIT ; Create list

 N TIUDATE,TIUDA,TIUIEN,TIUTM,TIUCNT,TIUDP,TIUNO,TIUTOTAL

 I '$G(TIUSDT)!'($G(TIUEDT)) Q

 S TIUDATE=TIUSDT,(TIUCNT,VALMCNT,TIUTOTAL)=0

 W !!,"Searching for the documents."

 S TIUTM("STR")=$$NOW^XLFDT

 F  S TIUDATE=$O(^TIU(8925,"F",TIUDATE)) Q:'TIUDATE!(TIUDATE>TIUEDT)  D

 .S TIUIEN=$O(^TIU(8925,"F",TIUDATE,0)),TIUCNT=TIUCNT+1 D GETINFO(TIUIEN)

 .W:TIUCNT#1000'>0 "."

 S TIUDA="" F  S TIUDA=$O(^TMP("TIUPS180",$J,TIUDA)) Q:TIUDA=""  D

 .S TIUTOTAL=+$G(TIUTOTAL)+1

 .S TIUDP=$$SETSTR^VALM1(TIUTOTAL,"",1,5)

 .S TIUDP=$$SETSTR^VALM1($P($$GET1^DIQ(8925,TIUDA,.02),",")_","_$E($P($$GET1^DIQ(8925,TIUDA,.02),",",2),1),TIUDP,6,18)

 .S TIUDP=$$SETSTR^VALM1("("_$$PATFMAT($P(^TIU(8925,TIUDA,0),U,2))_")",TIUDP,19,26)

 .S TIUDP=$$SETSTR^VALM1(TIUDA,TIUDP,28,36)

 .S TIUDP=$$SETSTR^VALM1($E($$GET1^DIQ(8925,TIUDA,1502),1,19),TIUDP,38,56)

 .S TIUDP=$$SETSTR^VALM1($P($$FMTE^XLFDT($P(^TIU(8925,TIUDA,12),U),2),"@"),TIUDP,58,68)

 .S TIUDP=$$SETSTR^VALM1($$GET1^DIQ(8925,TIUDA,.05),TIUDP,70,100)

 .D SET^VALM10(TIUTOTAL,TIUDP,TIUDA)

 S (VALMCNT,^TMP("TIU180",$J,"TOTAL"))=+$G(TIUTOTAL)

 I +$G(TIUTOTAL)'>0 D

 .S VALMCNT=1

 .D SET^VALM10(1," ",0)

 .S TIUNO="No records found to satisfy search criteria."

 .S TIUNO=$$SETSTR^VALM1(TIUNO,"",(IOM-$L(TIUNO))/2,$L(TIUNO))

 .D SET^VALM10(2,TIUNO,0)

 S TIUTM("END")=$$NOW^XLFDT

 W !!,"Report started:   ",$P($$FMTE^XLFDT(TIUTM("STR")),"@",2)

 W !,"Report finished:  ",$P($$FMTE^XLFDT(TIUTM("END")),"@",2)

 W !,"Total searched:   ",TIUCNT

GETINFO(TIUDA1) ;GET SIGNED DOCUMENT BUT UNSIGNED STATUS

 ; Input  -- TIUDA1 TIU Document file (#8925) IEN

 N TIUD0,TIUD15

 I TIUDA1'>0 Q

 I '$D(^TIU(8925,TIUDA1,0))!('$D(^TIU(8925,TIUDA1,15))) Q

 S TIUD0=$G(^TIU(8925,TIUDA1,0)),TIUD15=$G(^TIU(8925,TIUDA1,15))

 I $P(TIUD0,U,5)=5,$P(TIUD15,U,1)>0 D

 .S ^TMP("TIUPS180",$J,TIUDA1)=""

HELP ; -- help code

 N DIR

 I X="?" S DIR("A")="Enter RETURN to continue or '^' to exit",DIR(0)="E"

 D FULL^VALM1

 W !!,"The following actions are available:"

 W !,"Browse Document  - View selected documents (if authorized)"

 W !,"Detailed Display   - View detailed display of selected documents (if authorized)"

 W !,"Update Document  - Update the status of selected documents"

 I $D(DIR("A")) D ^DIR

 S VALMBCK="R"

ASKRNG(TIUBEGDT,TIUENDT) ;Prompt for date range

 ; Input  -- None

 ; Output -- 1=Successful and 0=Failure

 ;           BEGDT Begin Date

 ;           ENDT  End Date

 N DIRUT,DTOUT,DUOUT,Y

 W !,"Please specify a date range:",!

 S TIUBEGDT=+$$READ^TIUU("DA^:DT:E","   Start Reference Date: ")

 I +$D(DIRUT)!(TIUBEGDT'>0) G ASKRNGQ

 S TIUENDT=+$$READ^TIUU("DA^"_TIUBEGDT_":DT:E","  Ending Reference Date: ")_"."_235959

 I +$D(DIRUT)!(TIUENDT'>0) G ASKRNGQ

 S Y=1

ASKRNGQ Q +$G(Y)

PATFMAT(TIUPAT) ; format patient as first letter of last name and last 4 SSN

 N TIUPATN,TIULAST4,TIUINIT

 I 'TIUPAT Q ""

 S TIUPATN=$$EXTERNAL^DILFD(8925,.02,"",TIUPAT)

 S TIULAST4=$E($$GET1^DIQ(2,$G(TIUPAT),.09),6,9)

 S TIUINIT=$E($P(TIUPATN,","))

 Q TIUINIT_TIULAST4

EXIT ; -- exit code

 D XQORM

XQORM ; default action for list manager

 S XQORM("#")=$O(^ORD(101,"B","TIU SIGNED/UNSIGNED SELECT",0))_U_"1:"_VALMCNT

ACTIONS ; user selectable actions

 N ACTION

 . N DIR,DIRUT,POP,X,Y

 . S DIR(0)="SA^1:Browse Document;2:Detailed Display;3:Status Update"

 . S DIR("A")="Select Action: "

 . S DIR("B")="Status Update"

 . S DIR("L",1)="1.   Browse Document"

 . S DIR("L",2)="2.   Detailed Display"

 . S DIR("L",3)="3.   Status Update"

 . S DIR("L",4)=""

 . S DIR("L")="Enter selection by typing the name, number, or abbreviation"

 . S DIR("?",1)="The following actions are available:"

 . S DIR("?",2)=""

 . S DIR("?",3)="Browse Document  - View selected documents (if authorized)"

 . S DIR("?",4)="Detailed Display   - Detailed View of selected documents (if authorized)"

 . S DIR("?",5)="Status Update  - Update the status of selected documents"

 . D ^DIR Q:$D(DIRUT)

 . S ACTION=$S(+Y=1:"BROWSE^TIUSUPN1",+Y=2:"DISP^TIUSUPN1",+Y=3:"UPDTDOC^TIUSUPN1",Y=U:-1,1:-1)

 . Q:ACTION=-1

 . D @ACTION

 . S VALMBCK="R"

SELECT(ACTION) ; selects document(s) and calls ACTION

 N TIUDOCS,TIUSEL,TIUQUIT,TIUCNT,TIUDA

 D FULL^VALM1

 I $P(^TMP("TIU180",$J,"TOTAL"),U)=0 W !,"No documents to select." H 3 Q

 S TIUSEL=$P(XQORNOD(0),"=",2),TIUCNT=0

 I TIUSEL="" D  Q:$D(TIUQUIT)

 . N DIR,X,Y

 . S DIR("A")="Select Document(s)"

 . S DIR(0)="L^"_VALMBG_":"_VALMLST

 . D ^DIR I $D(DIRUT)!(Y=U) S TIUQUIT=1 Q

 . S TIUSEL=Y(0)

 F X=1:1  Q:$P(TIUSEL,",",X)=""  D

 . S TIUCNT=TIUCNT+1

 . S TIUDOCS($P(TIUSEL,",",X))=$O(@VALMAR@("IDX",$P(TIUSEL,",",X),""))

 . S ^TMP("TIUSEL",$J,TIUCNT)=$P(TIUSEL,",",X)

 I $D(TIUDOCS)'>1 S VALMBCK="R" Q

 D @ACTION

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSUPN   5586     printed  Feb 19, 2025@00:12:43                                                                                                                                                                                                     Page 2

TIUSUPN   ;;SLC/TT - TIU SIGNED/UNSIGNED List Manager ; 04-FEB-2005

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**180**;Jun 20, 1997

 +2       ;

 +3        QUIT

EN        ; -- main entry point for TIU SIGNED/UNSIGNED PN

 +1        NEW TIUSDT,TIUEDT

 +2        WRITE @IOF

 +3        KILL ^TMP("TIUPS180",$JOB),^TMP("TIUSEL",$JOB),^TMP("VALMAR",$JOB),^TMP("TIU180",$JOB)

 +4        IF '$$ASKRNG(.TIUSDT,.TIUEDT)

               QUIT

 +5        DO EN^VALM("TIU SIGNED/UNSIGNED")

 +6        QUIT

 +7       ;

HDR       ; -- header code

 +1        NEW HDR1,HDR2

 +2        SET HDR1="From "_$$FMTE^XLFDT(TIUSDT)_" to "_$$FMTE^XLFDT(TIUEDT,"D")

 +3        SET HDR2=$PIECE(^TMP("TIU180",$JOB,"TOTAL"),U)_" "_$SELECT($PIECE(^TMP("TIU180",$JOB,"TOTAL"),U)=0:"Document",$PIECE(^TMP("TIU180",$JOB,"TOTAL"),U)=1:"Document",1:"Documents")

 +4        SET VALMHDR(1)=$$SETSTR^VALM1(HDR1,"",(IOM-$LENGTH(HDR1))/2,$LENGTH(HDR1))

 +5        SET VALMHDR(2)=$$SETSTR^VALM1(HDR2,"",(IOM-$LENGTH(HDR2))/2,$LENGTH(HDR2))

 +6        DO XQORM

 +7        QUIT

 +8       ;

INIT      ; Create list

 +1        NEW TIUDATE,TIUDA,TIUIEN,TIUTM,TIUCNT,TIUDP,TIUNO,TIUTOTAL

 +2        IF '$GET(TIUSDT)!'($GET(TIUEDT))

               QUIT

 +3        SET TIUDATE=TIUSDT

           SET (TIUCNT,VALMCNT,TIUTOTAL)=0

 +4        WRITE !!,"Searching for the documents."

 +5        SET TIUTM("STR")=$$NOW^XLFDT

 +6        FOR

               SET TIUDATE=$ORDER(^TIU(8925,"F",TIUDATE))

               if 'TIUDATE!(TIUDATE>TIUEDT)

                   QUIT

               Begin DoDot:1

 +7                SET TIUIEN=$ORDER(^TIU(8925,"F",TIUDATE,0))

                   SET TIUCNT=TIUCNT+1

                   DO GETINFO(TIUIEN)

 +8                if TIUCNT#1000'>0

                       WRITE "."

               End DoDot:1

 +9       ;

 +10       SET TIUDA=""

FOR

               SET TIUDA=$ORDER(^TMP("TIUPS180",$JOB,TIUDA))

               if TIUDA=""

                   QUIT

               Begin DoDot:1

 +11               SET TIUTOTAL=+$GET(TIUTOTAL)+1

 +12               SET TIUDP=$$SETSTR^VALM1(TIUTOTAL,"",1,5)

 +13               SET TIUDP=$$SETSTR^VALM1($PIECE($$GET1^DIQ(8925,TIUDA,.02),",")_","_$EXTRACT($PIECE($$GET1^DIQ(8925,TIUDA,.02),",",2),1),TIUDP,6,18)

 +14               SET TIUDP=$$SETSTR^VALM1("("_$$PATFMAT($PIECE(^TIU(8925,TIUDA,0),U,2))_")",TIUDP,19,26)

 +15               SET TIUDP=$$SETSTR^VALM1(TIUDA,TIUDP,28,36)

 +16               SET TIUDP=$$SETSTR^VALM1($EXTRACT($$GET1^DIQ(8925,TIUDA,1502),1,19),TIUDP,38,56)

 +17               SET TIUDP=$$SETSTR^VALM1($PIECE($$FMTE^XLFDT($PIECE(^TIU(8925,TIUDA,12),U),2),"@"),TIUDP,58,68)

 +18               SET TIUDP=$$SETSTR^VALM1($$GET1^DIQ(8925,TIUDA,.05),TIUDP,70,100)

 +19               DO SET^VALM10(TIUTOTAL,TIUDP,TIUDA)

               End DoDot:1

 +20       SET (VALMCNT,^TMP("TIU180",$JOB,"TOTAL"))=+$GET(TIUTOTAL)

 +21       IF +$GET(TIUTOTAL)'>0

               Begin DoDot:1

 +22               SET VALMCNT=1

 +23               DO SET^VALM10(1," ",0)

 +24               SET TIUNO="No records found to satisfy search criteria."

 +25               SET TIUNO=$$SETSTR^VALM1(TIUNO,"",(IOM-$LENGTH(TIUNO))/2,$LENGTH(TIUNO))

 +26               DO SET^VALM10(2,TIUNO,0)

               End DoDot:1

 +27       SET TIUTM("END")=$$NOW^XLFDT

 +28       WRITE !!,"Report started:   ",$PIECE($$FMTE^XLFDT(TIUTM("STR")),"@",2)

 +29       WRITE !,"Report finished:  ",$PIECE($$FMTE^XLFDT(TIUTM("END")),"@",2)

 +30       WRITE !,"Total searched:   ",TIUCNT

 +31       QUIT

 +32      ;

GETINFO(TIUDA1) ;GET SIGNED DOCUMENT BUT UNSIGNED STATUS

 +1       ; Input  -- TIUDA1 TIU Document file (#8925) IEN

 +2       ;

 +3        NEW TIUD0,TIUD15

 +4        IF TIUDA1'>0

               QUIT

 +5        IF '$DATA(^TIU(8925,TIUDA1,0))!('$DATA(^TIU(8925,TIUDA1,15)))

               QUIT

 +6        SET TIUD0=$GET(^TIU(8925,TIUDA1,0))

           SET TIUD15=$GET(^TIU(8925,TIUDA1,15))

 +7        IF $PIECE(TIUD0,U,5)=5

               IF $PIECE(TIUD15,U,1)>0

                   Begin DoDot:1

 +8                    SET ^TMP("TIUPS180",$JOB,TIUDA1)=""

                   End DoDot:1

 +9        QUIT

 +10      ;

HELP      ; -- help code

 +1        NEW DIR

 +2        IF X="?"

               SET DIR("A")="Enter RETURN to continue or '^' to exit"

               SET DIR(0)="E"

 +3        DO FULL^VALM1

 +4        WRITE !!,"The following actions are available:"

 +5        WRITE !,"Browse Document  - View selected documents (if authorized)"

 +6        WRITE !,"Detailed Display   - View detailed display of selected documents (if authorized)"

 +7        WRITE !,"Update Document  - Update the status of selected documents"

 +8        IF $DATA(DIR("A"))

               DO ^DIR

 +9        SET VALMBCK="R"

 +10       QUIT

 +11      ;

ASKRNG(TIUBEGDT,TIUENDT) ;Prompt for date range

 +1       ; Input  -- None

 +2       ; Output -- 1=Successful and 0=Failure

 +3       ;           BEGDT Begin Date

 +4       ;           ENDT  End Date

 +5        NEW DIRUT,DTOUT,DUOUT,Y

 +6        WRITE !,"Please specify a date range:",!

 +7        SET TIUBEGDT=+$$READ^TIUU("DA^:DT:E","   Start Reference Date: ")

 +8        IF +$DATA(DIRUT)!(TIUBEGDT'>0)

               GOTO ASKRNGQ

 +9        SET TIUENDT=+$$READ^TIUU("DA^"_TIUBEGDT_":DT:E","  Ending Reference Date: ")_"."_235959

 +10       IF +$DATA(DIRUT)!(TIUENDT'>0)

               GOTO ASKRNGQ

 +11       SET Y=1

ASKRNGQ    QUIT +$GET(Y)

 +1       ;

PATFMAT(TIUPAT) ; format patient as first letter of last name and last 4 SSN

 +1        NEW TIUPATN,TIULAST4,TIUINIT

 +2        IF 'TIUPAT

               QUIT ""

 +3        SET TIUPATN=$$EXTERNAL^DILFD(8925,.02,"",TIUPAT)

 +4        SET TIULAST4=$EXTRACT($$GET1^DIQ(2,$GET(TIUPAT),.09),6,9)

 +5        SET TIUINIT=$EXTRACT($PIECE(TIUPATN,","))

 +6        QUIT TIUINIT_TIULAST4

 +7       ;

EXIT      ; -- exit code

 +1        DO XQORM

 +2        QUIT

 +3       ;

XQORM     ; default action for list manager

 +1        SET XQORM("#")=$ORDER(^ORD(101,"B","TIU SIGNED/UNSIGNED SELECT",0))_U_"1:"_VALMCNT

 +2        QUIT

 +3       ;

ACTIONS   ; user selectable actions

 +1        NEW ACTION

 +2        Begin DoDot:1

 +3            NEW DIR,DIRUT,POP,X,Y

 +4            SET DIR(0)="SA^1:Browse Document;2:Detailed Display;3:Status Update"

 +5            SET DIR("A")="Select Action: "

 +6            SET DIR("B")="Status Update"

 +7            SET DIR("L",1)="1.   Browse Document"

 +8            SET DIR("L",2)="2.   Detailed Display"

 +9            SET DIR("L",3)="3.   Status Update"

 +10           SET DIR("L",4)=""

 +11           SET DIR("L")="Enter selection by typing the name, number, or abbreviation"

 +12           SET DIR("?",1)="The following actions are available:"

 +13           SET DIR("?",2)=""

 +14           SET DIR("?",3)="Browse Document  - View selected documents (if authorized)"

 +15           SET DIR("?",4)="Detailed Display   - Detailed View of selected documents (if authorized)"

 +16           SET DIR("?",5)="Status Update  - Update the status of selected documents"

 +17           DO ^DIR

               if $DATA(DIRUT)

                   QUIT

 +18           SET ACTION=$SELECT(+Y=1:"BROWSE^TIUSUPN1",+Y=2:"DISP^TIUSUPN1",+Y=3:"UPDTDOC^TIUSUPN1",Y=U:-1,1:-1)

 +19           if ACTION=-1

                   QUIT

 +20           DO @ACTION

 +21           SET VALMBCK="R"

           End DoDot:1

 +22       QUIT

 +23      ;

SELECT(ACTION) ; selects document(s) and calls ACTION

 +1        NEW TIUDOCS,TIUSEL,TIUQUIT,TIUCNT,TIUDA

 +2        DO FULL^VALM1

 +3        IF $PIECE(^TMP("TIU180",$JOB,"TOTAL"),U)=0

               WRITE !,"No documents to select."

               HANG 3

               QUIT

 +4        SET TIUSEL=$PIECE(XQORNOD(0),"=",2)

           SET TIUCNT=0

 +5        IF TIUSEL=""

               Begin DoDot:1

 +6                NEW DIR,X,Y

 +7                SET DIR("A")="Select Document(s)"

 +8                SET DIR(0)="L^"_VALMBG_":"_VALMLST

 +9                DO ^DIR

                   IF $DATA(DIRUT)!(Y=U)

                       SET TIUQUIT=1

                       QUIT

 +10               SET TIUSEL=Y(0)

               End DoDot:1

               if $DATA(TIUQUIT)

                   QUIT

 +11       FOR X=1:1

               if $PIECE(TIUSEL,",",X)=""

                   QUIT

               Begin DoDot:1

 +12               SET TIUCNT=TIUCNT+1

 +13               SET TIUDOCS($PIECE(TIUSEL,",",X))=$ORDER(@VALMAR@("IDX",$PIECE(TIUSEL,",",X),""))

 +14               SET ^TMP("TIUSEL",$JOB,TIUCNT)=$PIECE(TIUSEL,",",X)

               End DoDot:1

 +15       IF $DATA(TIUDOCS)'>1

               SET VALMBCK="R"

               QUIT

 +16       DO @ACTION

 +17       QUIT

TIUSUPN.m