TIUSUPN ;;SLC/TT - TIU SIGNED/UNSIGNED List Manager ; 04-FEB-2005
;;1.0;TEXT INTEGRATION UTILITIES;**180**;Jun 20, 1997
;
Q
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")
Q
;
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
Q
;
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
Q
;
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)=""
Q
;
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"
Q
;
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
Q
;
XQORM ; default action for list manager
S XQORM("#")=$O(^ORD(101,"B","TIU SIGNED/UNSIGNED SELECT",0))_U_"1:"_VALMCNT
Q
;
ACTIONS ; user selectable actions
N ACTION
D
. 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"
Q
;
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSUPN 5586 printed Apr 09, 2024@21:43:09 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
