- 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 Feb 19, 2025@00:01:15 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
