- RTNQ2 ;MJK/TROY ISC;Record Inquiry Routine ; 5/4/87 9:57 AM ;
- ;;2.0;Record Tracking;**32,36**;10/22/91
- I '$D(RTAPL) D APL2^RTPSET D NEXT:$D(RTAPL) K RTAPL,RTSYS Q
- NEXT S RTA=+RTAPL D ASK^RTB K RTA G Q:$D(RTESC),RTNQ2:Y<0 S RTE=X
- S RTRD(1)="All^display all volumes for all record types",RTRD(2)="Type^display all volumes for a specific record type",RTRD(3)="Volume^display specific volumes",RTRD("B")=1,RTRD(0)="S"
- S RTRD("A")="Indicate what information to display: " D SET^RTRD K RTRD G Q:$E(X)="^" S RTINFO=$E(X)
- I RTINFO="T" S DIC(0)="IAEMQ",DIC="^DIC(195.2,",DIC("S")="I $P(^(0),U,3)=+RTAPL,$D(^RT(""AT"",Y,RTE))",DIC("A")="Select Record Type: " D ^DIC K DIC G Q:Y<0 S RTINFO="T^"_+Y
- I RTINFO="V" D VOL G Q:'$D(RTINFO)
- S RTPGM="START^RTNQ2",RTVAR="RTE^RTINFO^RTAPL" D ZIS^RTUTL G Q:POP D START G NEXT
- ;
- START U IO S RTPAGE=0,RTFL="RECS",RTUTL=0 K RT,^TMP($J,"RTNQ") I '$D(IOSL)!('$D(IOF)) S IOP="" D ^%ZIS K IOP
- D TYPE,HD I RTINFO["V" S X=$P(RTINFO,"^",2,99) F I=1:1 Q:'$P(X,"^",I) S RT(+$P(X,"^",I))=""
- I RTINFO["T" S T=+$P(RTINFO,"^",2) F RT=0:0 S RT=$O(^RT("AT",T,RTE,RT)) Q:'RT S RT(RT)=""
- I RTINFO["A" S A=+RTAPL F RT=0:0 S RT=$O(^RT("AA",A,RTE,RT)) Q:'RT S RT(RT)=""
- G Q:$D(RT)<10 K RTL F RT=0:0 S RT=$O(RT(RT)) Q:'RT K RT(RT) I $D(^RT(RT,0)) S RT0=^(0) I $D(RTO(+$P(RT0,"^",3))) S RT(RT)=RT0 D REC
- S C=0,RTESC="" K R F O=0:0 S O=$O(RTL(O)) Q:'O F V=0:0 S V=$O(RTL(O,V)) Q:'V S C=C+1,R(C)=^TMP($J,"RTNQ",RTL(O,V),1) D WRITE:C=3 G Q:RTESC="^"
- D WRITE:C,^RTNQ21:RTESC'["^"
- Q K C,S,RTVAR,RTPGM,RTQ,RTWND,RTDT,R,RT,RT0,RTA,RTE,RTESC,RTFL,RTINFO,RTL,RTO,RTPAGE,RTUTL,^TMP($J,"RTNQ") D CLOSE^RTUTL
- K I,Y,DUOUT,DIC,DIY,N,A,F,O,X1,%I,%H,POP,X Q
- VOL K RTY S RTDC("S")="I $P(^(0),U,4)="_+RTAPL,RTSEL="S",Y=RTE D NAME^RTB S RTSEL("A")="Select "_Y_"'s Record" D ^RTUTL2 K RTSEL I $D(RTY) F I=1:1 Q:'$D(RTY(I)) S $P(RTINFO,"^",I+1)=RTY(I)
- K:'$D(RTY) RTINFO K RT1,RTC,RTY,RTDC,RTSEL Q
- ;
- HD S RTESC="" I RTPAGE,IOST["C-" R !!,"Press RETURN to continue or '^' to stop: ",RTESC:DTIME S:'$T RTESC="^" Q:RTESC["^"
- S RTPAGE=RTPAGE+1,X1=$S($D(^DIC(195.1,+RTAPL,"HD")):^("HD"),1:"Record")_" Inquiry" D PTHD^RTUTL2,EQUALS^RTUTL3
- Q
- ;
- REC S Y=RT0 Q:'$D(^RT(RT,"CL")) S RTCL=^("CL"),R("BC")=$S($P(RTCL,"^",15)="y":"Barcode",1:"Non-barcode"),T=+$P(Y,"^",3),V=+$P(Y,"^",7),R("DES")=$P(Y,"^",12),Y=$P(Y,"^",11),C=$P(^DD(190,11,0),"^",2) D Y^DIQ S R("R")=Y
- S (H,H("P"))="" I $D(^RTV(195.9,+$P(RT0,"^",6),0)) S Y=^(0),H("P")=$P(Y,"^",7),Y=$P(Y,"^") D NAME^RTB S H=Y
- S Y=RTCL,D=$P(Y,"^",6)_".00000",D=$TR($$FMTE^XLFDT($E(D,1,12),"5F")," /","0-")
- S U1=$S($D(^VA(200,+$P(Y,"^",7),0)):$P(^(0),"^"),1:"UNKNOWN")
- S Y=+$P(Y,"^",8),C=$P(^DD(190,108,0),"^",2) D Y^DIQ S M=Y
- S R("I")="" I $D(^RT(RT,"I")),^("I"),DT>^("I") S R("I")=$S(M["TRANSFER TO":"** Transferred **",1:"*** Inactive ***")
- S (B,B("P"))="" I $D(^RTV(195.9,+$P(RTCL,"^",5),0)) S Y=^(0),B("P")=$P(Y,"^",7),Y=$P(Y,"^") D NAME^RTB S B=Y
- S Y=$P(RTCL,"^",14) D BOR^RTB:Y S R("PROV")=Y
- S RTUTL=RTUTL+1,RTL(+RTO(T),999-V)=RTUTL,^TMP($J,"RTNQ",RTUTL,1)=$P(RTO(T),"^",2)_"^"_V_"^"_RT_"^"_R("DES")_"^"_B_"^"_B("P")_"^"_R("PROV")_"^"_D_"^"_M_"^"_U1_"^"_H_"^"_H("P")_"^"_R("I")_"^"_R("R")_"^"_R("BC")
- RECQ K V,B,RTCL,D,H,R,M,U1,C,Y Q
- ;
- WRITE S RTN=15 D HD:($Y+RTN+3)>IOSL G WRITEQ:RTESC="^" F F=1:1:RTN W !,$P($T(LABELS+F),";;",2) F I=1:1 Q:'$D(R(I)) W ?(20+(20*(I-1))),$E($P(R(I),"^",F),1,19)
- WRITEQ K R,RTN S C=0 Q
- ;
- TYPE F T=0:0 S T=$O(^DIC(195.2,"C",+RTAPL,T)) Q:'T I $D(^DIC(195.2,T,0)) S O=$S($P(^(0),"^",4)]"":+$P(^(0),"^",4),1:0),RTO(T)=$S(O:O,1:0)_"^"_$P(^(0),"^",1,2)
- Q
- ;
- LABELS ;;
- ;;Type of Record :
- ;;Volume No. :
- ;;Record No. :
- ;;Descriptor :
- ;;Current Location:
- ;;Current Phone :
- ;;Associated Borr.:
- ;;Since... :
- ;;Movement :
- ;;Responsible User:
- ;;Home Location :
- ;;Home Phone :
- ;;Inactive Flag :
- ;;Retirement Flag :
- ;;Last Access Meth:
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTNQ2 3933 printed Feb 19, 2025@00:00:36 Page 2
- RTNQ2 ;MJK/TROY ISC;Record Inquiry Routine ; 5/4/87 9:57 AM ;
- +1 ;;2.0;Record Tracking;**32,36**;10/22/91
- +2 IF '$DATA(RTAPL)
- DO APL2^RTPSET
- if $DATA(RTAPL)
- DO NEXT
- KILL RTAPL,RTSYS
- QUIT
- NEXT SET RTA=+RTAPL
- DO ASK^RTB
- KILL RTA
- if $DATA(RTESC)
- GOTO Q
- if Y<0
- GOTO RTNQ2
- SET RTE=X
- +1 SET RTRD(1)="All^display all volumes for all record types"
- SET RTRD(2)="Type^display all volumes for a specific record type"
- SET RTRD(3)="Volume^display specific volumes"
- SET RTRD("B")=1
- SET RTRD(0)="S"
- +2 SET RTRD("A")="Indicate what information to display: "
- DO SET^RTRD
- KILL RTRD
- if $EXTRACT(X)="^"
- GOTO Q
- SET RTINFO=$EXTRACT(X)
- +3 IF RTINFO="T"
- SET DIC(0)="IAEMQ"
- SET DIC="^DIC(195.2,"
- SET DIC("S")="I $P(^(0),U,3)=+RTAPL,$D(^RT(""AT"",Y,RTE))"
- SET DIC("A")="Select Record Type: "
- DO ^DIC
- KILL DIC
- if Y<0
- GOTO Q
- SET RTINFO="T^"_+Y
- +4 IF RTINFO="V"
- DO VOL
- if '$DATA(RTINFO)
- GOTO Q
- +5 SET RTPGM="START^RTNQ2"
- SET RTVAR="RTE^RTINFO^RTAPL"
- DO ZIS^RTUTL
- if POP
- GOTO Q
- DO START
- GOTO NEXT
- +6 ;
- START USE IO
- SET RTPAGE=0
- SET RTFL="RECS"
- SET RTUTL=0
- KILL RT,^TMP($JOB,"RTNQ")
- IF '$DATA(IOSL)!('$DATA(IOF))
- SET IOP=""
- DO ^%ZIS
- KILL IOP
- +1 DO TYPE
- DO HD
- IF RTINFO["V"
- SET X=$PIECE(RTINFO,"^",2,99)
- FOR I=1:1
- if '$PIECE(X,"^",I)
- QUIT
- SET RT(+$PIECE(X,"^",I))=""
- +2 IF RTINFO["T"
- SET T=+$PIECE(RTINFO,"^",2)
- FOR RT=0:0
- SET RT=$ORDER(^RT("AT",T,RTE,RT))
- if 'RT
- QUIT
- SET RT(RT)=""
- +3 IF RTINFO["A"
- SET A=+RTAPL
- FOR RT=0:0
- SET RT=$ORDER(^RT("AA",A,RTE,RT))
- if 'RT
- QUIT
- SET RT(RT)=""
- +4 if $DATA(RT)<10
- GOTO Q
- KILL RTL
- FOR RT=0:0
- SET RT=$ORDER(RT(RT))
- if 'RT
- QUIT
- KILL RT(RT)
- IF $DATA(^RT(RT,0))
- SET RT0=^(0)
- IF $DATA(RTO(+$PIECE(RT0,"^",3)))
- SET RT(RT)=RT0
- DO REC
- +5 SET C=0
- SET RTESC=""
- KILL R
- FOR O=0:0
- SET O=$ORDER(RTL(O))
- if 'O
- QUIT
- FOR V=0:0
- SET V=$ORDER(RTL(O,V))
- if 'V
- QUIT
- SET C=C+1
- SET R(C)=^TMP($JOB,"RTNQ",RTL(O,V),1)
- if C=3
- DO WRITE
- if RTESC="^"
- GOTO Q
- +6 if C
- DO WRITE
- if RTESC'["^"
- DO ^RTNQ21
- Q KILL C,S,RTVAR,RTPGM,RTQ,RTWND,RTDT,R,RT,RT0,RTA,RTE,RTESC,RTFL,RTINFO,RTL,RTO,RTPAGE,RTUTL,^TMP($JOB,"RTNQ")
- DO CLOSE^RTUTL
- +1 KILL I,Y,DUOUT,DIC,DIY,N,A,F,O,X1,%I,%H,POP,X
- QUIT
- VOL KILL RTY
- SET RTDC("S")="I $P(^(0),U,4)="_+RTAPL
- SET RTSEL="S"
- SET Y=RTE
- DO NAME^RTB
- SET RTSEL("A")="Select "_Y_"'s Record"
- DO ^RTUTL2
- KILL RTSEL
- IF $DATA(RTY)
- FOR I=1:1
- if '$DATA(RTY(I))
- QUIT
- SET $PIECE(RTINFO,"^",I+1)=RTY(I)
- +1 if '$DATA(RTY)
- KILL RTINFO
- KILL RT1,RTC,RTY,RTDC,RTSEL
- QUIT
- +2 ;
- HD SET RTESC=""
- IF RTPAGE
- IF IOST["C-"
- READ !!,"Press RETURN to continue or '^' to stop: ",RTESC:DTIME
- if '$TEST
- SET RTESC="^"
- if RTESC["^"
- QUIT
- +1 SET RTPAGE=RTPAGE+1
- SET X1=$SELECT($DATA(^DIC(195.1,+RTAPL,"HD")):^("HD"),1:"Record")_" Inquiry"
- DO PTHD^RTUTL2
- DO EQUALS^RTUTL3
- +2 QUIT
- +3 ;
- REC SET Y=RT0
- if '$DATA(^RT(RT,"CL"))
- QUIT
- SET RTCL=^("CL")
- SET R("BC")=$SELECT($PIECE(RTCL,"^",15)="y":"Barcode",1:"Non-barcode")
- SET T=+$PIECE(Y,"^",3)
- SET V=+$PIECE(Y,"^",7)
- SET R("DES")=$PIECE(Y,"^",12)
- SET Y=$PIECE(Y,"^",11)
- SET C=$PIECE(^DD(190,11,0),"^",2)
- DO Y^DIQ
- SET R("R")=Y
- +1 SET (H,H("P"))=""
- IF $DATA(^RTV(195.9,+$PIECE(RT0,"^",6),0))
- SET Y=^(0)
- SET H("P")=$PIECE(Y,"^",7)
- SET Y=$PIECE(Y,"^")
- DO NAME^RTB
- SET H=Y
- +2 SET Y=RTCL
- SET D=$PIECE(Y,"^",6)_".00000"
- SET D=$TRANSLATE($$FMTE^XLFDT($EXTRACT(D,1,12),"5F")," /","0-")
- +3 SET U1=$SELECT($DATA(^VA(200,+$PIECE(Y,"^",7),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
- +4 SET Y=+$PIECE(Y,"^",8)
- SET C=$PIECE(^DD(190,108,0),"^",2)
- DO Y^DIQ
- SET M=Y
- +5 SET R("I")=""
- IF $DATA(^RT(RT,"I"))
- IF ^("I")
- IF DT>^("I")
- SET R("I")=$SELECT(M["TRANSFER TO":"** Transferred **",1:"*** Inactive ***")
- +6 SET (B,B("P"))=""
- IF $DATA(^RTV(195.9,+$PIECE(RTCL,"^",5),0))
- SET Y=^(0)
- SET B("P")=$PIECE(Y,"^",7)
- SET Y=$PIECE(Y,"^")
- DO NAME^RTB
- SET B=Y
- +7 SET Y=$PIECE(RTCL,"^",14)
- if Y
- DO BOR^RTB
- SET R("PROV")=Y
- +8 SET RTUTL=RTUTL+1
- SET RTL(+RTO(T),999-V)=RTUTL
- SET ^TMP($JOB,"RTNQ",RTUTL,1)=$PIECE(RTO(T),"^",2)_"^"_V_"^"_RT_"^"_R("DES")_"^"_B_"^"_B("P")_"^"_R("PROV")_"^"_D_"^"_M_"^"_U1_"^"_H_"^"_H("P")_"^"_R("I")_"^"_R("R")_"^"_R("BC")
- RECQ KILL V,B,RTCL,D,H,R,M,U1,C,Y
- QUIT
- +1 ;
- WRITE SET RTN=15
- if ($Y+RTN+3)>IOSL
- DO HD
- if RTESC="^"
- GOTO WRITEQ
- FOR F=1:1:RTN
- WRITE !,$PIECE($TEXT(LABELS+F),";;",2)
- FOR I=1:1
- if '$DATA(R(I))
- QUIT
- WRITE ?(20+(20*(I-1))),$EXTRACT($PIECE(R(I),"^",F),1,19)
- WRITEQ KILL R,RTN
- SET C=0
- QUIT
- +1 ;
- TYPE FOR T=0:0
- SET T=$ORDER(^DIC(195.2,"C",+RTAPL,T))
- if 'T
- QUIT
- IF $DATA(^DIC(195.2,T,0))
- SET O=$SELECT($PIECE(^(0),"^",4)]"":+$PIECE(^(0),"^",4),1:0)
- SET RTO(T)=$SELECT(O:O,1:0)_"^"_$PIECE(^(0),"^",1,2)
- +1 QUIT
- +2 ;
- LABELS ;;
- +1 ;;Type of Record :
- +2 ;;Volume No. :
- +3 ;;Record No. :
- +4 ;;Descriptor :
- +5 ;;Current Location:
- +6 ;;Current Phone :
- +7 ;;Associated Borr.:
- +8 ;;Since... :
- +9 ;;Movement :
- +10 ;;Responsible User:
- +11 ;;Home Location :
- +12 ;;Home Phone :
- +13 ;;Inactive Flag :
- +14 ;;Retirement Flag :
- +15 ;;Last Access Meth:
