- IBDFU9 ;ALB/CJM - ENCOUNTER FORM - post-selection action for package interface file, screen for data qualifiers;OCT 18,1993
- ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- ;
- ASK ;post-slection action for package interface
- Q:'$D(VALMEVL) ; only ask if in listman
- Q:DIC["358.6"
- N LINE,DA,ANS,TYPE
- S DA=+Y
- I $G(DA),$D(^IBE(357.6,DA,1)) D
- .S TYPE=$P($G(^IBE(357.6,DA,0)),"^",6)
- .;
- .; -- see if we can find a marker and quit if in fileman
- .;
- .; -- in the case of reports, the post-selection action is not executed
- .; until after the report is created in the setup, so it's not useful
- .Q:TYPE=4
- .;
- .S TYPE=$S(TYPE=1:"type of data",TYPE=2:"type of data",TYPE=3:"type of data",TYPE=4:"report",1:"package interface")
- .S LINE=0 W ! F S LINE=$O(^IBE(357.6,DA,1,LINE)) Q:'LINE W !,$G(^IBE(357.6,DA,1,LINE,0))
- .W !!,"Are you sure this is the right "_TYPE_"?: "
- .R ANS:DTIME
- .I '$T S Y=-1 Q
- .I ANS["?" W !!,"Enter Y for YES if the data is correct.",!,"Enter N for NO if the data is not correct." D
- ..W !!,"Are you sure this is the right "_TYPE_"?: "
- ..R ANS:DTIME
- .I (ANS["^")!(ANS["?")!(ANS="")!("Yy"'[$E(ANS,1)) S Y=-1
- Q
- ;
- DQGOOD(PI,QLFR) ;screen for data modifiers
- ;
- N NODE
- Q:'$G(PI) 0
- Q:'$G(QLFR) 0
- S NODE=$G(^IBE(357.6,PI,0))
- ;
- ;for selection interfaces, the list of data qualifiers is kept with the input interface
- I $P(NODE,"^",6)=3 S PI=$P(NODE,"^",13)
- Q:'PI 0
- Q $D(^IBE(357.6,PI,13,"B",QLFR_";IBD(357.98,"))
- ;
- DTGOOD(PI,TYPE) ;screen for datatypes
- ;
- N NODE
- Q:'$G(PI) 0
- Q:'$G(TYPE) 0
- S NODE=$G(^IBE(357.6,PI,0))
- ;
- ;for selection interfaces, the list of data qualifiers is kept with the input interface
- I $P(NODE,"^",6)=3 S PI=$P(NODE,"^",13)
- Q:'PI 0
- Q $D(^IBE(357.6,PI,13,"B",TYPE_";IBE(359.1,"))
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFU9 1800 printed Feb 19, 2025@00:20:09 Page 2
- IBDFU9 ;ALB/CJM - ENCOUNTER FORM - post-selection action for package interface file, screen for data qualifiers;OCT 18,1993
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- +2 ;
- ASK ;post-slection action for package interface
- +1 ; only ask if in listman
- if '$DATA(VALMEVL)
- QUIT
- +2 if DIC["358.6"
- QUIT
- +3 NEW LINE,DA,ANS,TYPE
- +4 SET DA=+Y
- +5 IF $GET(DA)
- IF $DATA(^IBE(357.6,DA,1))
- Begin DoDot:1
- +6 SET TYPE=$PIECE($GET(^IBE(357.6,DA,0)),"^",6)
- +7 ;
- +8 ; -- see if we can find a marker and quit if in fileman
- +9 ;
- +10 ; -- in the case of reports, the post-selection action is not executed
- +11 ; until after the report is created in the setup, so it's not useful
- +12 if TYPE=4
- QUIT
- +13 ;
- +14 SET TYPE=$SELECT(TYPE=1:"type of data",TYPE=2:"type of data",TYPE=3:"type of data",TYPE=4:"report",1:"package interface")
- +15 SET LINE=0
- WRITE !
- FOR
- SET LINE=$ORDER(^IBE(357.6,DA,1,LINE))
- if 'LINE
- QUIT
- WRITE !,$GET(^IBE(357.6,DA,1,LINE,0))
- +16 WRITE !!,"Are you sure this is the right "_TYPE_"?: "
- +17 READ ANS:DTIME
- +18 IF '$TEST
- SET Y=-1
- QUIT
- +19 IF ANS["?"
- WRITE !!,"Enter Y for YES if the data is correct.",!,"Enter N for NO if the data is not correct."
- Begin DoDot:2
- +20 WRITE !!,"Are you sure this is the right "_TYPE_"?: "
- +21 READ ANS:DTIME
- End DoDot:2
- +22 IF (ANS["^")!(ANS["?")!(ANS="")!("Yy"'[$EXTRACT(ANS,1))
- SET Y=-1
- End DoDot:1
- +23 QUIT
- +24 ;
- DQGOOD(PI,QLFR) ;screen for data modifiers
- +1 ;
- +2 NEW NODE
- +3 if '$GET(PI)
- QUIT 0
- +4 if '$GET(QLFR)
- QUIT 0
- +5 SET NODE=$GET(^IBE(357.6,PI,0))
- +6 ;
- +7 ;for selection interfaces, the list of data qualifiers is kept with the input interface
- +8 IF $PIECE(NODE,"^",6)=3
- SET PI=$PIECE(NODE,"^",13)
- +9 if 'PI
- QUIT 0
- +10 QUIT $DATA(^IBE(357.6,PI,13,"B",QLFR_";IBD(357.98,"))
- +11 ;
- DTGOOD(PI,TYPE) ;screen for datatypes
- +1 ;
- +2 NEW NODE
- +3 if '$GET(PI)
- QUIT 0
- +4 if '$GET(TYPE)
- QUIT 0
- +5 SET NODE=$GET(^IBE(357.6,PI,0))
- +6 ;
- +7 ;for selection interfaces, the list of data qualifiers is kept with the input interface
- +8 IF $PIECE(NODE,"^",6)=3
- SET PI=$PIECE(NODE,"^",13)
- +9 if 'PI
- QUIT 0
- +10 QUIT $DATA(^IBE(357.6,PI,13,"B",TYPE_";IBE(359.1,"))