- RTDPA2 ;MJK/TROY ISC;Request File Look-up; ; 5/19/87 11:22 AM ; 1/30/03 9:32am
- ;;2.0;Record Tracking;**21,41**;10/22/91
- RTQ K RTESC,RTQ S:$D(DIC("A")) RTQDC("A")=DIC("A") S:$D(DIC("B")) RTQDC("B")=DIC("B")
- S RTQSEL=RTSEL,DIC="^RTV(190.1,",RTQDC(0)=DIC(0) S:$D(DIC("S")) RTQDC("S")=DIC("S") S X1=DIC(0),DIC(0)=$P(X1,"^")_$P(X1,"^",2,99) G RTQ1:DIC(0)'["A"
- ASK W !!,$S($D(RTQDC("A")):RTQDC("A"),1:"Select Request: ") W:$D(RTQDC("B")) RTQDC("B"),"// " R X:DTIME I $T,X="",$D(RTQDC("B")) S X=RTQDC("B")
- RTQ1 S RTXQ=X I "^"[$E(X) S RTESC="" G Q1
- I X?1"REQ"1N.ANP S W=$E(X,1,$L(X)-1) D CHAR^RTDPA G Q:Y<0!(C'=$E(X,$L(X))) S Y=+$P(W,"REQ",2) K W G NUM
- I X=" " G Q:'$D(^DISV($S($D(DUZ)'[0:DUZ,1:0),"^RTV(190.1,")) S Y=+^("^RTV(190.1,") G NUM
- I $E(X)="?" D HELP K RTQ G Q
- I X?1N.N!(X?1"`"1N.N),X'?4N S Y=$S($E(X)="`":+$P(X,"`",2),1:X) G NUM
- I RTQDC(0)["M",$E(X,1,2)="B."!($E(X,1,2)="b.") S X=$E(X,3,99) G BOR
- S RTSEL="",DIC(0)="IEM" D ^RTDPA K RTBCIFN,RTY,RTC,RTSEL,DIC G Q:'$D(RT) S RTSEL=RTQSEL,RTE=$P(Y,"^",2) D RT^RTUTL4 G:'$D(RTY) ASK:RTQDC(0)["A",Q1
- I RTC=1,$D(RTY(1)) S RTQ=+RTY(1) G RTC
- I $D(RTY),RTSEL["S"!(RTSEL["A") G Q1
- K RTY,RTC I RTQDC(0)'["L"!('$D(RT)) G Q
- I $S($D(DLAYGO):190.1-(DLAYGO\1),1:1),DUZ(0)'="@",$D(^DIC(190.1,0,"LAYGO")) F %=1:1 I DUZ(0)[$E(^("LAYGO"),%) G Q:%>$L(^("LAYGO")) Q
- S Y=RTE D NAME^RTB
- S RTRD(1)="Yes^create a new request",RTRD(2)="No^do not create a new request",RTRD(0)="S",RTRD("B")=2,RTRD("A")="Do you want to create a new request for "_Y_"'s "_$S($D(^DIC(195.2,+$P(^RT(RT,0),"^",3),0)):$P(^(0),"^"),1:"UNKNOWN")_" ?"
- D SET^RTRD K RTRD S X=$E(X) G Q:X="N"!(X="^") S RTSHOW="" D SET^RTQ K RTSHOW,RTB,RTINST,RTQDT G RTC
- ;
- NUM I $D(^RTV(190.1,Y,0)) S Q0=^(0) X:$D(RTQDC("S")) RTQDC("S") I $T!('$D(RTQDC("S"))) S RTQ=Y I RTQDC(0)["E" S Y=$S($D(^RT(+Q0,0)):$P(^(0),"^"),1:"UNKNOWN") D NAME^RTB W " ",Y S Y=RTQ D DPA2^RTUTL1
- G Q:'$D(RTQ)
- RTC S RTC=1,RTY(1)=RTQ,(^DISV($S($D(DUZ)'[0:DUZ,1:0),"^RTV(190.1,"),RTY(1))=RTQ
- S Y=RTQ_"^"_$P(^RTV(190.1,RTQ,0),"^") S:RTQDC(0)["Z" Y(0)=^(0)
- Q I '$D(RTQ) W:RTXQ'["?"&(RTQDC(0)["Q") *7," ??" G ASK:RTQDC(0)["A"
- Q1 S:'$D(RTQ) Y=-1 S X=RTXQ K Q0,RTXQ,RTIX,RTS,RTSEL,RTQSEL,DIC,RTQDC Q
- ;
- HELP S:$E(X)'["?" X="?" S DIC(0)="IE",DIC="^RTV(190.1," S:$D(RTQDC("S")) DIC("S")=RTQDC("S") D ^DIC K DIC Q
- ;
- BOR K DIC S DIC="^RTV(195.9,",DIC("A")="Select Borrower: ",DIC(0)="IEMLQ",DIC("DR")="3////"_+RTAPL,DIC("S")="I $P(^(0),U,3)="_+RTAPL D ^DIC K DIC I Y<0 G ASK:RTQDC(0)["A",Q1
- S:$D(RTB) RTZZ("RTB")=RTB S RTSEL=$S(RTQSEL["S":"S",1:""),RTB=+Y,RTASK="" D START^RTRPT1 S:$D(RTZZ("RTB")) RTB=RTZZ("RTB") K RTZZ I '$D(RTY) G ASK:RTQDC(0)["A",Q1
- I RTC=1,$D(RTY(1)) S RTQ=+RTY(1) G RTC
- G Q1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTDPA2 2700 printed Mar 13, 2025@21:38:58 Page 2
- RTDPA2 ;MJK/TROY ISC;Request File Look-up; ; 5/19/87 11:22 AM ; 1/30/03 9:32am
- +1 ;;2.0;Record Tracking;**21,41**;10/22/91
- RTQ KILL RTESC,RTQ
- if $DATA(DIC("A"))
- SET RTQDC("A")=DIC("A")
- if $DATA(DIC("B"))
- SET RTQDC("B")=DIC("B")
- +1 SET RTQSEL=RTSEL
- SET DIC="^RTV(190.1,"
- SET RTQDC(0)=DIC(0)
- if $DATA(DIC("S"))
- SET RTQDC("S")=DIC("S")
- SET X1=DIC(0)
- SET DIC(0)=$PIECE(X1,"^")_$PIECE(X1,"^",2,99)
- if DIC(0)'["A"
- GOTO RTQ1
- ASK WRITE !!,$SELECT($DATA(RTQDC("A")):RTQDC("A"),1:"Select Request: ")
- if $DATA(RTQDC("B"))
- WRITE RTQDC("B"),"// "
- READ X:DTIME
- IF $TEST
- IF X=""
- IF $DATA(RTQDC("B"))
- SET X=RTQDC("B")
- RTQ1 SET RTXQ=X
- IF "^"[$EXTRACT(X)
- SET RTESC=""
- GOTO Q1
- +1 IF X?1"REQ"1N.ANP
- SET W=$EXTRACT(X,1,$LENGTH(X)-1)
- DO CHAR^RTDPA
- if Y<0!(C'=$EXTRACT(X,$LENGTH(X)))
- GOTO Q
- SET Y=+$PIECE(W,"REQ",2)
- KILL W
- GOTO NUM
- +2 IF X=" "
- if '$DATA(^DISV($SELECT($DATA(DUZ)'[0:DUZ,1:0),"^RTV(190.1,"))
- GOTO Q
- SET Y=+^("^RTV(190.1,")
- GOTO NUM
- +3 IF $EXTRACT(X)="?"
- DO HELP
- KILL RTQ
- GOTO Q
- +4 IF X?1N.N!(X?1"`"1N.N)
- IF X'?4N
- SET Y=$SELECT($EXTRACT(X)="`":+$PIECE(X,"`",2),1:X)
- GOTO NUM
- +5 IF RTQDC(0)["M"
- IF $EXTRACT(X,1,2)="B."!($EXTRACT(X,1,2)="b.")
- SET X=$EXTRACT(X,3,99)
- GOTO BOR
- +6 SET RTSEL=""
- SET DIC(0)="IEM"
- DO ^RTDPA
- KILL RTBCIFN,RTY,RTC,RTSEL,DIC
- if '$DATA(RT)
- GOTO Q
- SET RTSEL=RTQSEL
- SET RTE=$PIECE(Y,"^",2)
- DO RT^RTUTL4
- if '$DATA(RTY)
- if RTQDC(0)["A"
- GOTO ASK
- GOTO Q1
- +7 IF RTC=1
- IF $DATA(RTY(1))
- SET RTQ=+RTY(1)
- GOTO RTC
- +8 IF $DATA(RTY)
- IF RTSEL["S"!(RTSEL["A")
- GOTO Q1
- +9 KILL RTY,RTC
- IF RTQDC(0)'["L"!('$DATA(RT))
- GOTO Q
- +10 IF $SELECT($DATA(DLAYGO):190.1-(DLAYGO\1),1:1)
- IF DUZ(0)'="@"
- IF $DATA(^DIC(190.1,0,"LAYGO"))
- FOR %=1:1
- IF DUZ(0)[$EXTRACT(^("LAYGO"),%)
- if %>$LENGTH(^("LAYGO"))
- GOTO Q
- QUIT
- +11 SET Y=RTE
- DO NAME^RTB
- +12 SET RTRD(1)="Yes^create a new request"
- SET RTRD(2)="No^do not create a new request"
- SET RTRD(0)="S"
- SET RTRD("B")=2
- SET RTRD("A")="Do you want to create a new request for "_Y_"'s "_$SELECT($DATA(^DIC(195.2,+$PIECE(^RT(RT,0),"^",3),0)):$PIECE(^(0),"^"),1:"UNKNOWN")_" ?"
- +13 DO SET^RTRD
- KILL RTRD
- SET X=$EXTRACT(X)
- if X="N"!(X="^")
- GOTO Q
- SET RTSHOW=""
- DO SET^RTQ
- KILL RTSHOW,RTB,RTINST,RTQDT
- GOTO RTC
- +14 ;
- NUM IF $DATA(^RTV(190.1,Y,0))
- SET Q0=^(0)
- if $DATA(RTQDC("S"))
- XECUTE RTQDC("S")
- IF $TEST!('$DATA(RTQDC("S")))
- SET RTQ=Y
- IF RTQDC(0)["E"
- SET Y=$SELECT($DATA(^RT(+Q0,0)):$PIECE(^(0),"^"),1:"UNKNOWN")
- DO NAME^RTB
- WRITE " ",Y
- SET Y=RTQ
- DO DPA2^RTUTL1
- +1 if '$DATA(RTQ)
- GOTO Q
- RTC SET RTC=1
- SET RTY(1)=RTQ
- SET (^DISV($SELECT($DATA(DUZ)'[0:DUZ,1:0),"^RTV(190.1,"),RTY(1))=RTQ
- +1 SET Y=RTQ_"^"_$PIECE(^RTV(190.1,RTQ,0),"^")
- if RTQDC(0)["Z"
- SET Y(0)=^(0)
- Q IF '$DATA(RTQ)
- if RTXQ'["?"&(RTQDC(0)["Q")
- WRITE *7," ??"
- if RTQDC(0)["A"
- GOTO ASK
- Q1 if '$DATA(RTQ)
- SET Y=-1
- SET X=RTXQ
- KILL Q0,RTXQ,RTIX,RTS,RTSEL,RTQSEL,DIC,RTQDC
- QUIT
- +1 ;
- HELP if $EXTRACT(X)'["?"
- SET X="?"
- SET DIC(0)="IE"
- SET DIC="^RTV(190.1,"
- if $DATA(RTQDC("S"))
- SET DIC("S")=RTQDC("S")
- DO ^DIC
- KILL DIC
- QUIT
- +1 ;
- BOR KILL DIC
- SET DIC="^RTV(195.9,"
- SET DIC("A")="Select Borrower: "
- SET DIC(0)="IEMLQ"
- SET DIC("DR")="3////"_+RTAPL
- SET DIC("S")="I $P(^(0),U,3)="_+RTAPL
- DO ^DIC
- KILL DIC
- IF Y<0
- if RTQDC(0)["A"
- GOTO ASK
- GOTO Q1
- +1 if $DATA(RTB)
- SET RTZZ("RTB")=RTB
- SET RTSEL=$SELECT(RTQSEL["S":"S",1:"")
- SET RTB=+Y
- SET RTASK=""
- DO START^RTRPT1
- if $DATA(RTZZ("RTB"))
- SET RTB=RTZZ("RTB")
- KILL RTZZ
- IF '$DATA(RTY)
- if RTQDC(0)["A"
- GOTO ASK
- GOTO Q1
- +2 IF RTC=1
- IF $DATA(RTY(1))
- SET RTQ=+RTY(1)
- GOTO RTC
- +3 GOTO Q1
