RTSM2 ;MJK/TROY ISC;Record File Initialization Utility; ; 5/27/87 9:17 AM ;
;;v 2.0;Record Tracking;;10/22/91
SEL K RTHOLD W !!?5,"For each patient, the following records",$S('$D(RTION):"",RTION]"":" and labels",1:"")," will be created:"
S Y=+$P(RTAPL,"^",10) D TYPE1^RTUTL G SELQ1:'$D(RTTY) W !?20,$P($P(RTTY,"^"),";",2) S Y=+RTTY,RTN=0 K ^TMP($J,"RT") D SET
F I=0:0 S I=$O(^DIC(195.2,+RTTY,"LINKED",I)) Q:'I I $D(^(I,0)) S I1=+^(0) I $D(^DIC(195.2,I1,0)) W !?20,$P(^(0),"^") S Y=I1 D SET
SEL1 K RTDEL R !!,"Select Type of Record: ",X:DTIME D HELP:$E(X)="?" G SEL1:'$D(X),SELQ:X=""!(X["^") S:$E(X)="-" RTDEL="",X=$E(X,2,99)
S DIC(0)="IEMNQ",DIC="^DIC(195.2,",DIC("S")="I $P(^(0),U,3)="_+RTAPL_",$P(^(0),U,15)'=""y""" D ^DIC K DIC G SEL:X["?" I Y>0 S Y=+Y D ARRAY1^RTUTL1 G SEL1
SELQ I '$D(^TMP($J,"RT")) W !?3,"...no types of records selected" G SELQ1
S RTHOLD="" F I=0:0 S I=+$O(^TMP($J,"RT","XREF",I)) Q:'I S RTHOLD=RTHOLD_I_"^"
S Y=$S('$D(RTION):"",RTION]"":" and labels",1:""),RTRD(1)="Yes^ok to create records"_Y,RTRD(2)="No^do NOT create records"_Y,RTRD("B")=2
S RTRD("A")="Do you want to create these records"_Y_"? ",RTRD(0)="S" D SET^RTRD K RTRD I $E(X)'="Y" K RTHOLD
SELQ1 K RTDEL Q
;
HELP W !!,"Types of Records already selected:" F I=0:0 S I=+$O(^TMP($J,"RT","XREF",I)) Q:'I W !?10,I," - ",$P(^DIC(195.2,I,0),"^")
W !!?3,"Also, you can delete a selected type by entering a",!?3,"'minus' sign(-) before the type number (eg. Select Record: -2).",!
Q
;
SET S RTN=RTN+1,^TMP($J,"RT","AR",RTN)=+Y,^TMP($J,"RT","XREF",+Y)=RTN Q
;
TERM K RTERM D LIST S RTC=100,RTRD("A")="Select Terminal Digits: ",RTSEL="S" D SEL^RTRD I $D(RTY(51)) W !?3,*7,"...allowed to choose a maximum of fifty terminal digits at a time." G TERM
I $D(RTY) S Y=RTY($O(RTY(0))),RTERM="" F I=0:0 S I=$O(RTY(I)) Q:'I S RTERM=RTERM_RTY(I)_"^"
I $D(RTERM),RTLOAD="PAT^RTSM3" D BEG I '$D(RTSTART) K RTERM G TERM
TERMQ K RTC,I,I1,RTS,RTY,RTRD,RTSEL Q
;
LIST W !!?5,"Selecting...",?20,"Chooses patients with SSN's ending with..."
F I=1:1:100 S I1=$S(I=100:"00",I<10:"0"_I,1:I) W:I<12!(I>97) !?10,I,?35,I1 W:I>12&(I<16) !?10,".",?35,"." S RTS(I)=I1
Q
;
BEG S X1="0000000"_Y W !!,"Printing will start at SSN#: ",X1,"// " R X:DTIME G BEGQ:'$T!(X["^") I X'="",X'?9N S X="?"
I X["?" W !!,"Enter an SSN# that ends with '",Y,"'." G BEG
S:X="" X=X1 I X?9N,$E(X,8,9)=Y S X=$E(X,8,9)_$E(X,6,7)_$E(X,1,5),RTSTART=$S($E(X):X-1,1:$E(X,1,8)_$C($A($E(X,9))-1))
W:'$D(RTSTART) !!,*7,"Starting SSN must end with '",Y,"'."
BEGQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTSM2 2540 printed Oct 16, 2024@18:35:28 Page 2
RTSM2 ;MJK/TROY ISC;Record File Initialization Utility; ; 5/27/87 9:17 AM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
SEL KILL RTHOLD
WRITE !!?5,"For each patient, the following records",$SELECT('$DATA(RTION):"",RTION]"":" and labels",1:"")," will be created:"
+1 SET Y=+$PIECE(RTAPL,"^",10)
DO TYPE1^RTUTL
if '$DATA(RTTY)
GOTO SELQ1
WRITE !?20,$PIECE($PIECE(RTTY,"^"),";",2)
SET Y=+RTTY
SET RTN=0
KILL ^TMP($JOB,"RT")
DO SET
+2 FOR I=0:0
SET I=$ORDER(^DIC(195.2,+RTTY,"LINKED",I))
if 'I
QUIT
IF $DATA(^(I,0))
SET I1=+^(0)
IF $DATA(^DIC(195.2,I1,0))
WRITE !?20,$PIECE(^(0),"^")
SET Y=I1
DO SET
SEL1 KILL RTDEL
READ !!,"Select Type of Record: ",X:DTIME
if $EXTRACT(X)="?"
DO HELP
if '$DATA(X)
GOTO SEL1
if X=""!(X["^")
GOTO SELQ
if $EXTRACT(X)="-"
SET RTDEL=""
SET X=$EXTRACT(X,2,99)
+1 SET DIC(0)="IEMNQ"
SET DIC="^DIC(195.2,"
SET DIC("S")="I $P(^(0),U,3)="_+RTAPL_",$P(^(0),U,15)'=""y"""
DO ^DIC
KILL DIC
if X["?"
GOTO SEL
IF Y>0
SET Y=+Y
DO ARRAY1^RTUTL1
GOTO SEL1
SELQ IF '$DATA(^TMP($JOB,"RT"))
WRITE !?3,"...no types of records selected"
GOTO SELQ1
+1 SET RTHOLD=""
FOR I=0:0
SET I=+$ORDER(^TMP($JOB,"RT","XREF",I))
if 'I
QUIT
SET RTHOLD=RTHOLD_I_"^"
+2 SET Y=$SELECT('$DATA(RTION):"",RTION]"":" and labels",1:"")
SET RTRD(1)="Yes^ok to create records"_Y
SET RTRD(2)="No^do NOT create records"_Y
SET RTRD("B")=2
+3 SET RTRD("A")="Do you want to create these records"_Y_"? "
SET RTRD(0)="S"
DO SET^RTRD
KILL RTRD
IF $EXTRACT(X)'="Y"
KILL RTHOLD
SELQ1 KILL RTDEL
QUIT
+1 ;
HELP WRITE !!,"Types of Records already selected:"
FOR I=0:0
SET I=+$ORDER(^TMP($JOB,"RT","XREF",I))
if 'I
QUIT
WRITE !?10,I," - ",$PIECE(^DIC(195.2,I,0),"^")
+1 WRITE !!?3,"Also, you can delete a selected type by entering a",!?3,"'minus' sign(-) before the type number (eg. Select Record: -2).",!
+2 QUIT
+3 ;
SET SET RTN=RTN+1
SET ^TMP($JOB,"RT","AR",RTN)=+Y
SET ^TMP($JOB,"RT","XREF",+Y)=RTN
QUIT
+1 ;
TERM KILL RTERM
DO LIST
SET RTC=100
SET RTRD("A")="Select Terminal Digits: "
SET RTSEL="S"
DO SEL^RTRD
IF $DATA(RTY(51))
WRITE !?3,*7,"...allowed to choose a maximum of fifty terminal digits at a time."
GOTO TERM
+1 IF $DATA(RTY)
SET Y=RTY($ORDER(RTY(0)))
SET RTERM=""
FOR I=0:0
SET I=$ORDER(RTY(I))
if 'I
QUIT
SET RTERM=RTERM_RTY(I)_"^"
+2 IF $DATA(RTERM)
IF RTLOAD="PAT^RTSM3"
DO BEG
IF '$DATA(RTSTART)
KILL RTERM
GOTO TERM
TERMQ KILL RTC,I,I1,RTS,RTY,RTRD,RTSEL
QUIT
+1 ;
LIST WRITE !!?5,"Selecting...",?20,"Chooses patients with SSN's ending with..."
+1 FOR I=1:1:100
SET I1=$SELECT(I=100:"00",I<10:"0"_I,1:I)
if I<12!(I>97)
WRITE !?10,I,?35,I1
if I>12&(I<16)
WRITE !?10,".",?35,"."
SET RTS(I)=I1
+2 QUIT
+3 ;
BEG SET X1="0000000"_Y
WRITE !!,"Printing will start at SSN#: ",X1,"// "
READ X:DTIME
if '$TEST!(X["^")
GOTO BEGQ
IF X'=""
IF X'?9N
SET X="?"
+1 IF X["?"
WRITE !!,"Enter an SSN# that ends with '",Y,"'."
GOTO BEG
+2 if X=""
SET X=X1
IF X?9N
IF $EXTRACT(X,8,9)=Y
SET X=$EXTRACT(X,8,9)_$EXTRACT(X,6,7)_$EXTRACT(X,1,5)
SET RTSTART=$SELECT($EXTRACT(X):X-1,1:$EXTRACT(X,1,8)_$CHAR($ASCII($EXTRACT(X,9))-1))
+3 if '$DATA(RTSTART)
WRITE !!,*7,"Starting SSN must end with '",Y,"'."
BEGQ QUIT
