ONCOSINP ;WASH ISC/SRR,MLH-INPUT SUBROUTINES FOR ONCOS ;11/1/93 12:16
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;These entry points perform miscellaneous input functions:
;GETFILE get a FileMan file
;GETYES get a yes/no response
;GETTEMPL get a search template
;
GETFILE ;lookup file, get file number & global reference
;in: ONCOS("F")=file name
;out: ONCOS("FI")=file number^file name^global reference OR Y=-1
N DIC
S X=$S($D(ONCOS("F")):ONCOS("F"),1:""),DIC="^DIC(",DIC(0)=$S(X="":"AEQ",1:"EQ") D ^DIC Q:Y<0 S GBL=^DIC(+Y,0,"GL"),FNUM=+Y,ONCOS("FI")=Y_GBL W !,"FILE: ",X Q
Q
;
GETTEMPL ;get a search template
;in: FNUM,ONCOS,^DIBT
;out: Y
N D,DIC,DIR
I $D(ONCOS("T")) S Y=ONCOS("T") Q:Y="ALL" I $D(^DIBT("F"_FNUM,Y)) S X=$O(^(Y,"")) I X]"" W !,"SEARCH TEMPLATE: ",Y S Y=X_U_Y Q
;S Y="Use a SEARCH TEMPLATE? Yes// ",Z="Use a SEARCH TEMPLATE to restrict cases"
ASK W ! S DIR("A")=" Restrict cases with a SEARCH TEMPLATE",DIR("B")="Yes",DIR(0)="Y",DIR("??")="^D HP1^ONCOSINP" D ^DIR G GT2:$G(Y)=0 S Y=$S(Y["^":-1,Y="":0,1:1) Q:Y'>0 G GT2:Y=2
Z S D="F"_FNUM,DIC="^DIBT(",DIC(0)="AEQ",DIC("A")=" Select SEARCH TEMPLATE: " D ^DIC S Y=$S(Y="^":0,Y="":0,Y=-1:0,1:Y) Q:'Y S N=+Y
X ;D GETYES E Q:Y=-1 G GT2
I '$D(^DIBT(N,"DIS")) W !,"Sorry, ",$P(Y,U,2)," must be a SEARCH template" G GT1
I '$D(^DIBT(N,1)) W !!,?10,$P(Y,U,2)_" does not have stored entries",!?10,"you must run FM Search Option for this template.",!! G GT1
W !!?10,"REMINDER: Run Define Search Criteria Option"
W !,?10,"to be sure selected entries are up-to-date!!",!
;S DIR("A")="Continue",DIR(0)="Y",DIR("B")="Yes" D ^DIR W ! S Y=$S(Y=1:1,1:0)
;Line above caused program to quit with NO DEATHS
Q
Q
GT2 W ! S Y="Really use ALL cases (this may take some time)? No// ",Z=""
D GETYES I S Y="ALL"
E G:Y'=-1 ASK
Q
HP1 W !!?10,"Using a Search Template will restrict cases.",!
W ?10,"It will act as a filter using only those cases",!
W ?10,"that fit the criteria you have selected."
W W !!,?10,"YOU MUST have FIRST GENERATED the Search Template using the",!?10,"DS Option to create the necessary 'TRUE' entries!",!!
Q
GT1 S D="F"_FNUM D IX^DIC G GT2:$P(Y,U,2)="ALL" Q:Y=-1 Q:$O(^DIBT(+Y,1,""))]""
Q
;
GETYES ;get a yes/no response
;in: Y = prompt (including default e.g. Yes//)
; Z = undefined if specific help handled by calling module
; '="" for single line help
;out: X = actual entry
; $T = true if yes
; Y = -1 for ^
W !,Y R X:DTIME E S X="^"
I X'[U
E S Y=-1 Q
I X="" S X=$F(Y,"//"),X=$S(X>3:$E(Y,X-5,X-3),1:"?")
I '(X["Y"!(X["y")!(X["N")!(X["n")) W *7 S X="?"
I X["?" W !,"Enter 'y' or 'n' or '^' to abort." Q:'$D(Z) W:Z'="" !,Z G GETYES
I X["Y"!(X["y") W " (Yes)"
E W " (No)"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOSINP 2791 printed Apr 09, 2024@21:25:35 Page 2
ONCOSINP ;WASH ISC/SRR,MLH-INPUT SUBROUTINES FOR ONCOS ;11/1/93 12:16
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;These entry points perform miscellaneous input functions:
+3 ;GETFILE get a FileMan file
+4 ;GETYES get a yes/no response
+5 ;GETTEMPL get a search template
+6 ;
GETFILE ;lookup file, get file number & global reference
+1 ;in: ONCOS("F")=file name
+2 ;out: ONCOS("FI")=file number^file name^global reference OR Y=-1
+3 NEW DIC
+4 SET X=$SELECT($DATA(ONCOS("F")):ONCOS("F"),1:"")
SET DIC="^DIC("
SET DIC(0)=$SELECT(X="":"AEQ",1:"EQ")
DO ^DIC
if Y<0
QUIT
SET GBL=^DIC(+Y,0,"GL")
SET FNUM=+Y
SET ONCOS("FI")=Y_GBL
WRITE !,"FILE: ",X
QUIT
+5 QUIT
+6 ;
GETTEMPL ;get a search template
+1 ;in: FNUM,ONCOS,^DIBT
+2 ;out: Y
+3 NEW D,DIC,DIR
+4 IF $DATA(ONCOS("T"))
SET Y=ONCOS("T")
if Y="ALL"
QUIT
IF $DATA(^DIBT("F"_FNUM,Y))
SET X=$ORDER(^(Y,""))
IF X]""
WRITE !,"SEARCH TEMPLATE: ",Y
SET Y=X_U_Y
QUIT
+5 ;S Y="Use a SEARCH TEMPLATE? Yes// ",Z="Use a SEARCH TEMPLATE to restrict cases"
ASK WRITE !
SET DIR("A")=" Restrict cases with a SEARCH TEMPLATE"
SET DIR("B")="Yes"
SET DIR(0)="Y"
SET DIR("??")="^D HP1^ONCOSINP"
DO ^DIR
if $GET(Y)=0
GOTO GT2
SET Y=$SELECT(Y["^":-1,Y="":0,1:1)
if Y'>0
QUIT
if Y=2
GOTO GT2
Z SET D="F"_FNUM
SET DIC="^DIBT("
SET DIC(0)="AEQ"
SET DIC("A")=" Select SEARCH TEMPLATE: "
DO ^DIC
SET Y=$SELECT(Y="^":0,Y="":0,Y=-1:0,1:Y)
if 'Y
QUIT
SET N=+Y
X ;D GETYES E Q:Y=-1 G GT2
+1 IF '$DATA(^DIBT(N,"DIS"))
WRITE !,"Sorry, ",$PIECE(Y,U,2)," must be a SEARCH template"
GOTO GT1
+2 IF '$DATA(^DIBT(N,1))
WRITE !!,?10,$PIECE(Y,U,2)_" does not have stored entries",!?10,"you must run FM Search Option for this template.",!!
GOTO GT1
+3 WRITE !!?10,"REMINDER: Run Define Search Criteria Option"
+4 WRITE !,?10,"to be sure selected entries are up-to-date!!",!
+5 ;S DIR("A")="Continue",DIR(0)="Y",DIR("B")="Yes" D ^DIR W ! S Y=$S(Y=1:1,1:0)
+6 ;Line above caused program to quit with NO DEATHS
+7 QUIT
+8 QUIT
GT2 WRITE !
SET Y="Really use ALL cases (this may take some time)? No// "
SET Z=""
+1 DO GETYES
IF $TEST
SET Y="ALL"
+2 IF '$TEST
if Y'=-1
GOTO ASK
+3 QUIT
HP1 WRITE !!?10,"Using a Search Template will restrict cases.",!
+1 WRITE ?10,"It will act as a filter using only those cases",!
+2 WRITE ?10,"that fit the criteria you have selected."
W WRITE !!,?10,"YOU MUST have FIRST GENERATED the Search Template using the",!?10,"DS Option to create the necessary 'TRUE' entries!",!!
+1 QUIT
GT1 SET D="F"_FNUM
DO IX^DIC
if $PIECE(Y,U,2)="ALL"
GOTO GT2
if Y=-1
QUIT
if $ORDER(^DIBT(+Y,1,""))]""
QUIT
+1 QUIT
+2 ;
GETYES ;get a yes/no response
+1 ;in: Y = prompt (including default e.g. Yes//)
+2 ; Z = undefined if specific help handled by calling module
+3 ; '="" for single line help
+4 ;out: X = actual entry
+5 ; $T = true if yes
+6 ; Y = -1 for ^
+7 WRITE !,Y
READ X:DTIME
IF '$TEST
SET X="^"
+8 IF X'[U
+9 IF '$TEST
SET Y=-1
QUIT
+10 IF X=""
SET X=$FIND(Y,"//")
SET X=$SELECT(X>3:$EXTRACT(Y,X-5,X-3),1:"?")
+11 IF '(X["Y"!(X["y")!(X["N")!(X["n"))
WRITE *7
SET X="?"
+12 IF X["?"
WRITE !,"Enter 'y' or 'n' or '^' to abort."
if '$DATA(Z)
QUIT
if Z'=""
WRITE !,Z
GOTO GETYES
+13 IF X["Y"!(X["y")
WRITE " (Yes)"
+14 IF '$TEST
WRITE " (No)"
+15 QUIT
