- RTUTL ;MJK/TROY ISC; Utility Routine; ; 5/5/87 10:16 AM ;
- ;;v 2.0;Record Tracking;**9,26**;10/22/91
- TYPE W ! S DIC="^DIC(195.2,",DIC("S")="I $P(^(0),U,3)=+RTAPL",DIC("A")="Select Record Type: ",DIC(0)="IAEMQ" D ^DIC K DIC Q:Y<0
- TYPE1 K RTTY Q:'$D(^DIC(195.2,+Y,0)) S RTTY=+Y_";"_^(0) Q
- ;
- INST K F,RTINST Q:$S(X="":1,'$D(^RT(+^RTV(190.1,DA,0),0)):1,1:0) S A=+$P(^(0),"^",4)
- ;Entry pt with A equal to application and X equal to borrower
- ;Returns RTINST equals institution file pointer
- INST1 K F,RTINST S X=$S($D(^RTV(195.9,+X,0)):$P(^(0),"^"),1:"") G INSTQ:'X S F=$P(X,";",2)
- I F="DIC(4,",$D(^DIC(4,+X,0)) S RTINST=+X G INSTQ
- S I=+$O(^DIC(195.1,A,"INST",0)) I I,'$O(^(I)),$D(^DIC(4,I,0)) S RTINST=I G INSTQ
- I F="SC(" S X1=+X D DIV G INSTQ
- I F="DIC(42,",$D(^DIC(42,+X,44)) S X1=+^(44) D DIV G INSTQ
- I F="VA(200," D
- . N Y,Y1
- . S Y=$O(^VA(200,+X,2,0)),Y1=$O(^(+Y))
- . I Y1 Q ; two or more divisions...user must select
- . I Y S RTINST=Y Q ; only one entry for division
- . S RTINST=$P($G(^XTV(8989.3,1,"XUS")),"^",17) ; use site default
- . I 'RTINST K RTINST
- INSTQ I $D(RTINST),F'="DIC(4,",'$D(^DIC(195.1,A,"INST",RTINST,0)) K RTINST
- K F,X1,I,I1 Q
- ;
- DIV I $D(^SC(X1,0)),$D(^DIC(4,+$P(^(0),"^",4),0)) S RTINST=+$P(^SC(X1,0),"^",4)
- Q
- ;
- Q X ^%ZOSF("UCI") S ZTUCI=Y,ZTRTN="DQ^RTUTL"
- F RTI="RTHD","RTVAR","RTPGM","DUZ(0)" I $D(@RTI) S ZTSAVE(RTI)=""
- F RTI=1:1 Q:$P(RTVAR,"^",RTI)']"" S ZTSAVE($P(RTVAR,"^",RTI))=@($P(RTVAR,"^",RTI))
- S ZTDESC=$S($D(RTDESC):RTDESC,1:"Record Tracking Job")
- S X1=ION_";"_IOST_";"_IOM,ZTIO=$S(X1=";;":"",1:X1) D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" K RTDESC,RTI,RTPGM,RTVAR,ZTSK Q
- ;
- DQ S IO(0)=IO,U="^" S X="T",%DT="" D ^%DT S DT=Y G @RTPGM
- ;
- ZIS S:$S('$D(RTDEV):0,1:RTDEV]"") %ZIS("B")=RTDEV S %ZIS="QMP" D ^%ZIS K %ZIS K:POP IO("Q") Q:POP I $D(IO("Q"))!(IO'=IO(0)) D Q S POP=1 Q
- Q
- ;
- CLOSE K ZTSK D ^%ZISC U:IO'=IO(0)&(IO]"") IO(0) Q
- ;
- DATE S POP=0 K RTBEG,RTEND W !!,"**** Date Range Selection ****"
- W ! S %DT="AETX",%DT("A")=" Beginning DATE/TIME : " D ^%DT S:Y<0 POP=1 Q:Y<0 S (%DT(0),RTBEG)=Y
- W ! S %DT="AETX",%DT("A")=" Ending DATE/TIME : " D ^%DT K %DT S:Y<0 POP=1 Q:Y<0 W ! S RTEND=Y
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTUTL 2205 printed Mar 13, 2025@21:40:11 Page 2
- RTUTL ;MJK/TROY ISC; Utility Routine; ; 5/5/87 10:16 AM ;
- +1 ;;v 2.0;Record Tracking;**9,26**;10/22/91
- TYPE WRITE !
- SET DIC="^DIC(195.2,"
- SET DIC("S")="I $P(^(0),U,3)=+RTAPL"
- SET DIC("A")="Select Record Type: "
- SET DIC(0)="IAEMQ"
- DO ^DIC
- KILL DIC
- if Y<0
- QUIT
- TYPE1 KILL RTTY
- if '$DATA(^DIC(195.2,+Y,0))
- QUIT
- SET RTTY=+Y_";"_^(0)
- QUIT
- +1 ;
- INST KILL F,RTINST
- if $SELECT(X=""
- QUIT
- SET A=+$PIECE(^(0),"^",4)
- +1 ;Entry pt with A equal to application and X equal to borrower
- +2 ;Returns RTINST equals institution file pointer
- INST1 KILL F,RTINST
- SET X=$SELECT($DATA(^RTV(195.9,+X,0)):$PIECE(^(0),"^"),1:"")
- if 'X
- GOTO INSTQ
- SET F=$PIECE(X,";",2)
- +1 IF F="DIC(4,"
- IF $DATA(^DIC(4,+X,0))
- SET RTINST=+X
- GOTO INSTQ
- +2 SET I=+$ORDER(^DIC(195.1,A,"INST",0))
- IF I
- IF '$ORDER(^(I))
- IF $DATA(^DIC(4,I,0))
- SET RTINST=I
- GOTO INSTQ
- +3 IF F="SC("
- SET X1=+X
- DO DIV
- GOTO INSTQ
- +4 IF F="DIC(42,"
- IF $DATA(^DIC(42,+X,44))
- SET X1=+^(44)
- DO DIV
- GOTO INSTQ
- +5 IF F="VA(200,"
- Begin DoDot:1
- +6 NEW Y,Y1
- +7 SET Y=$ORDER(^VA(200,+X,2,0))
- SET Y1=$ORDER(^(+Y))
- +8 ; two or more divisions...user must select
- IF Y1
- QUIT
- +9 ; only one entry for division
- IF Y
- SET RTINST=Y
- QUIT
- +10 ; use site default
- SET RTINST=$PIECE($GET(^XTV(8989.3,1,"XUS")),"^",17)
- +11 IF 'RTINST
- KILL RTINST
- End DoDot:1
- INSTQ IF $DATA(RTINST)
- IF F'="DIC(4,"
- IF '$DATA(^DIC(195.1,A,"INST",RTINST,0))
- KILL RTINST
- +1 KILL F,X1,I,I1
- QUIT
- +2 ;
- DIV IF $DATA(^SC(X1,0))
- IF $DATA(^DIC(4,+$PIECE(^(0),"^",4),0))
- SET RTINST=+$PIECE(^SC(X1,0),"^",4)
- +1 QUIT
- +2 ;
- Q XECUTE ^%ZOSF("UCI")
- SET ZTUCI=Y
- SET ZTRTN="DQ^RTUTL"
- +1 FOR RTI="RTHD","RTVAR","RTPGM","DUZ(0)"
- IF $DATA(@RTI)
- SET ZTSAVE(RTI)=""
- +2 FOR RTI=1:1
- if $PIECE(RTVAR,"^",RTI)']""
- QUIT
- SET ZTSAVE($PIECE(RTVAR,"^",RTI))=@($PIECE(RTVAR,"^",RTI))
- +3 SET ZTDESC=$SELECT($DATA(RTDESC):RTDESC,1:"Record Tracking Job")
- +4 SET X1=ION_";"_IOST_";"_IOM
- SET ZTIO=$SELECT(X1=";;":"",1:X1)
- DO ^%ZTLOAD
- if $DATA(ZTSK)
- WRITE !,"REQUEST QUEUED!"
- KILL RTDESC,RTI,RTPGM,RTVAR,ZTSK
- QUIT
- +5 ;
- DQ SET IO(0)=IO
- SET U="^"
- SET X="T"
- SET %DT=""
- DO ^%DT
- SET DT=Y
- GOTO @RTPGM
- +1 ;
- ZIS if $SELECT('$DATA(RTDEV)
- SET %ZIS("B")=RTDEV
- SET %ZIS="QMP"
- DO ^%ZIS
- KILL %ZIS
- if POP
- KILL IO("Q")
- if POP
- QUIT
- IF $DATA(IO("Q"))!(IO'=IO(0))
- DO Q
- SET POP=1
- QUIT
- +1 QUIT
- +2 ;
- CLOSE KILL ZTSK
- DO ^%ZISC
- if IO'=IO(0)&(IO]"")
- USE IO(0)
- QUIT
- +1 ;
- DATE SET POP=0
- KILL RTBEG,RTEND
- WRITE !!,"**** Date Range Selection ****"
- +1 WRITE !
- SET %DT="AETX"
- SET %DT("A")=" Beginning DATE/TIME : "
- DO ^%DT
- if Y<0
- SET POP=1
- if Y<0
- QUIT
- SET (%DT(0),RTBEG)=Y
- +2 WRITE !
- SET %DT="AETX"
- SET %DT("A")=" Ending DATE/TIME : "
- DO ^%DT
- KILL %DT
- if Y<0
- SET POP=1
- if Y<0
- QUIT
- WRITE !
- SET RTEND=Y
- +3 QUIT
- +4 ;
