AQAOEDTS ; IHS/ORDC/LJF - MULTIPLE FIELDS EDITS ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn is called by various data entry rtns to handle file-driven
;user interface for the section defined before this call.
;
OPT ; >>> get data entry option from review type
Q:'$D(^AQAQX(AQAOPT,0)) ;bad pointer in review type file
;
; >>> for each review, choose multiples to enter/edit
LOOP ; >>> find all screens available to work on & put in proper order
S AQAOSC=0 ;screen's entry # in multiple
F S AQAOSC=$O(^AQAQX(AQAOPT,"PG","B",AQAOSC)) Q:AQAOSC="" D
.S AQAOSN=0 ;screen's order #
.F S AQAOSN=$O(^AQAQX(AQAOPT,"PG","B",AQAOSC,AQAOSN)) Q:AQAOSN="" D
..Q:'$D(^AQAQX(AQAOPT,"PG",AQAOSN,0))
..S AQAOPTL=$P(^AQAQX(AQAOPT,"PG",AQAOSN,0),U,3) ;screen title
..S AQAOP(AQAOSC)=AQAOPTL_U_AQAOSN ;array with screens in order
..Q
;
; >>> loop thru array for each screen and allow user to edit
S AQAOSC=0,X="" K DUOUT ;PATCH 3
F S AQAOSC=$O(AQAOP(AQAOSC)) Q:AQAOSC="" Q:$D(DUOUT) Q:X=U D
.S AQAOPTL=$P(AQAOP(AQAOSC),U),AQAOSN=$P(AQAOP(AQAOSC),U,2)
.K DIR S Y=$P(^AQAQX(AQAOPT,"PG",AQAOSN,0),U,2)
.S C=$P(^DD(9002166.11,.02,0),U,2) D Y^DIQ S DIR("A")=Y
.;
.; >>> display items and ask user for choice, and then edit via ^die
.S AQAOSTR=$G(^AQAQX(AQAOPT,"PG",AQAOSN,1))
.I ($P(AQAOSTR,U)'="") D MULTFIND Q ;multiple entries in linked file
.D ITEMFIND Q ;multiple fields in occ file
;
END Q
;
;
ITEMFIND ; >> SUBRTN to find each items on screen and display them by number<<
;
; >>> find items for this screen
K AQAOA S AQAOTM=0 W !!!,"<<",AQAOPTL,">>",!
F S AQAOTM=$O(^AQAQX(AQAOPT,"PG",AQAOSN,"IT","B",AQAOTM)) Q:AQAOTM'=+AQAOTM D
.S AQAOTMN=0
.F S AQAOTMN=$O(^AQAQX(AQAOPT,"PG",AQAOSN,"IT","B",AQAOTM,AQAOTMN)) Q:AQAOTMN="" D
..Q:'$D(^AQAQX(AQAOPT,"PG",AQAOSN,"IT",AQAOTMN,0)) S AQAOMFL=^(0)
..;
..; >>> print items in order with contents and save field # in array
..S AQAOFLD=$P(AQAOMFL,U,2)
..W !,$J(+AQAOMFL,2),") ",$P(^DD(9002167,AQAOFLD,0),U) ;# & descrpt
..K ^UTILITY("DIQ1",$J) K DIQ,DR
..S (DIC,AQAOFL)=9002167,DA=AQAOIFN,DR=AQAOFLD D EN^DIQ1
..I $D(^UTILITY("DIQ1",$J,AQAOFL,DA,AQAOFLD)) W ?45,^(AQAOFLD)
..K ^UTILITY("DIQ1",$J)
..S AQAOA(+AQAOMFL)=AQAOFLD ;set array with # and field
;
; >>> choose items to edit and edit via ^die
S (AQAOTM,AQAOXX)=0 W !
F S AQAOXX=$O(AQAOA(AQAOXX)) Q:AQAOXX="" S AQAOTM=AQAOXX
S DIR("?")="Choose option from list above"
S DIR(0)="LO^0:"_AQAOTM_"^K:X#1 X" D ^DIR Q:$D(DIRUT) Q:Y=-1 S DR=""
I +Y=0 F S X=$O(AQAOA(X)) Q:X="" D ;user chose all
.I AQAOA(X)[U S DR(2,$P(AQAOA(X),U,2))=$P(AQAOA(X),U,3)
.S DR=DR_";"_$P(AQAOA(X),U)
E F S X=$P(Y,",") Q:X="" D ;user chose range by number
.I AQAOA(X)[U S DR(2,$P(AQAOA(X),U,3))=$P(AQAOA(X),U,2)
.S X=$P(AQAOA(X),U),DR=DR_";"_X
.S Y=$P(Y,",",2,99)
I DR?1";".E S DR=$E(DR,2,99)
K DIE S DIE=9002167,DA=AQAOIFN D ^DIE
;
S AQAODIR=DIR("A") K DIR S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Do you wish to EDIT this category again" D ^DIR K DIR
I Y=1 S AQAOTM=0,DIR("A")=AQAODIR K AQAODIR W !! G ITEMFIND
Q
; >>end of ITEMFIND subrtn<<
;
;
;
MULTFIND ; >>SUBRTN to display multiple entries in linked files<<
; >>> set variables about linked file
S AQAOFL=$P(AQAOSTR,U),AQAOFLD=$P(AQAOSTR,U,2) ;file#, fields to edit
S AQAOGBL=^DIC(AQAOFL,0,"GL") ;global node for file
S AQAOXX=0,AQAOXY=AQAOGBL_"""AB"",AQAOIFN,AQAOXX)" ;set global xref
;
S AQAOQUIT=0 W !!!,"<<",AQAOPTL,">>",! ;print screen heading
S X=$G(^AQAQX(AQAOPT,"PG",AQAOSN,2)) I X]"" X X ;special rtn for screen
I AQAOQUIT=1 Q ;special rtn found cause to quit edit of this screen
;
; >>> loop thru entries in linked file and display them by #
S (AQAOXX,AQAOCNT)=0
F S AQAOXX=$O(@AQAOXY) Q:AQAOXX'=+AQAOXX D
.S AQAOTM=$P(@(AQAOGBL_"AQAOXX,0)"),U) ;.01 field of linked file
.S AQAOCNT=AQAOCNT+1,AQAOA(AQAOCNT)=AQAOXX
.S Y=AQAOTM,C=$P(^DD(AQAOFL,.01,0),U,2) D Y^DIQ
.W !,AQAOCNT,") ",Y
.S X=$G(^AQAQX(AQAOPT,"PG",AQAOSN,4)) I X["" X X ;identifier code
.Q
;
; >>> last number is choice to add new entry
I AQAOCNT=0 D ADD G MULTFIND:$O(@AQAOXY) Q
S AQAOCNT=AQAOCNT+1 W !,AQAOCNT,") ADD NEW ENTRY"
;
CHOOSE ; >>> choose item(s) to edit
W ! S DIR(0)="NO^1:"_AQAOCNT,DIR("?")="Choose from list above"
D ^DIR Q:X="" Q:$D(DIRUT) G CHOOSE:Y=-1
I (+Y=AQAOCNT) D ADD G MULTFIND
E S DA=AQAOA(+Y) D EDIT G MULTFIND
;
ADD ;add new entry to subfile or edit entries already there
K DIC S DIE="^AQAOC(",DLAYGO=AQAOFL,DA=AQAOIFN
S DR=AQAOFLD_" ADD]" D ^DIE W ! Q
;
EDIT ; >>> edit entries
K DIC,DIE S DIE=AQAOGBL,DIDEL=AQAOFL
S DR=AQAOFLD_" EDIT]" D ^DIE W ! Q
;
; >>end of MULTFIND subrtn<<
AQAOEDTS ; IHS/ORDC/LJF - MULTIPLE FIELDS EDITS ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn is called by various data entry rtns to handle file-driven
+4 ;user interface for the section defined before this call.
+5 ;
OPT ; >>> get data entry option from review type
+1 ;bad pointer in review type file
IF '$DATA(^AQAQX(AQAOPT,0))
QUIT
+2 ;
+3 ; >>> for each review, choose multiples to enter/edit
LOOP ; >>> find all screens available to work on & put in proper order
+1 ;screen's entry # in multiple
SET AQAOSC=0
+2 FOR
SET AQAOSC=$ORDER(^AQAQX(AQAOPT,"PG","B",AQAOSC))
IF AQAOSC=""
QUIT
Begin DoDot:1
+3 ;screen's order #
SET AQAOSN=0
+4 FOR
SET AQAOSN=$ORDER(^AQAQX(AQAOPT,"PG","B",AQAOSC,AQAOSN))
IF AQAOSN=""
QUIT
Begin DoDot:2
+5 IF '$DATA(^AQAQX(AQAOPT,"PG",AQAOSN,0))
QUIT
+6 ;screen title
SET AQAOPTL=$PIECE(^AQAQX(AQAOPT,"PG",AQAOSN,0),U,3)
+7 ;array with screens in order
SET AQAOP(AQAOSC)=AQAOPTL_U_AQAOSN
+8 QUIT
End DoDot:2
End DoDot:1
+9 ;
+10 ; >>> loop thru array for each screen and allow user to edit
+11 ;PATCH 3
SET AQAOSC=0
SET X=""
KILL DUOUT
+12 FOR
SET AQAOSC=$ORDER(AQAOP(AQAOSC))
IF AQAOSC=""
QUIT
IF $DATA(DUOUT)
QUIT
IF X=U
QUIT
Begin DoDot:1
+13 SET AQAOPTL=$PIECE(AQAOP(AQAOSC),U)
SET AQAOSN=$PIECE(AQAOP(AQAOSC),U,2)
+14 KILL DIR
SET Y=$PIECE(^AQAQX(AQAOPT,"PG",AQAOSN,0),U,2)
+15 SET C=$PIECE(^DD(9002166.11,.02,0),U,2)
DO Y^DIQ
SET DIR("A")=Y
+16 ;
+17 ; >>> display items and ask user for choice, and then edit via ^die
+18 SET AQAOSTR=$GET(^AQAQX(AQAOPT,"PG",AQAOSN,1))
+19 ;multiple entries in linked file
IF ($PIECE(AQAOSTR,U)'="")
DO MULTFIND
QUIT
+20 ;multiple fields in occ file
DO ITEMFIND
QUIT
End DoDot:1
+21 ;
END QUIT
+1 ;
+2 ;
ITEMFIND ; >> SUBRTN to find each items on screen and display them by number<<
+1 ;
+2 ; >>> find items for this screen
+3 KILL AQAOA
SET AQAOTM=0
WRITE !!!,"<<",AQAOPTL,">>",!
+4 FOR
SET AQAOTM=$ORDER(^AQAQX(AQAOPT,"PG",AQAOSN,"IT","B",AQAOTM))
IF AQAOTM'=+AQAOTM
QUIT
Begin DoDot:1
+5 SET AQAOTMN=0
+6 FOR
SET AQAOTMN=$ORDER(^AQAQX(AQAOPT,"PG",AQAOSN,"IT","B",AQAOTM,AQAOTMN))
IF AQAOTMN=""
QUIT
Begin DoDot:2
+7 IF '$DATA(^AQAQX(AQAOPT,"PG",AQAOSN,"IT",AQAOTMN,0))
QUIT
SET AQAOMFL=^(0)
+8 ;
+9 ; >>> print items in order with contents and save field # in array
+10 SET AQAOFLD=$PIECE(AQAOMFL,U,2)
+11 ;# & descrpt
WRITE !,$JUSTIFY(+AQAOMFL,2),") ",$PIECE(^DD(9002167,AQAOFLD,0),U)
+12 KILL ^UTILITY("DIQ1",$JOB)
KILL DIQ,DR
+13 SET (DIC,AQAOFL)=9002167
SET DA=AQAOIFN
SET DR=AQAOFLD
DO EN^DIQ1
+14 IF $DATA(^UTILITY("DIQ1",$JOB,AQAOFL,DA,AQAOFLD))
WRITE ?45,^(AQAOFLD)
+15 KILL ^UTILITY("DIQ1",$JOB)
+16 ;set array with # and field
SET AQAOA(+AQAOMFL)=AQAOFLD
End DoDot:2
End DoDot:1
+17 ;
+18 ; >>> choose items to edit and edit via ^die
+19 SET (AQAOTM,AQAOXX)=0
WRITE !
+20 FOR
SET AQAOXX=$ORDER(AQAOA(AQAOXX))
IF AQAOXX=""
QUIT
SET AQAOTM=AQAOXX
+21 SET DIR("?")="Choose option from list above"
+22 SET DIR(0)="LO^0:"_AQAOTM_"^K:X#1 X"
DO ^DIR
IF $DATA(DIRUT)
QUIT
IF Y=-1
QUIT
SET DR=""
+23 ;user chose all
IF +Y=0
FOR
SET X=$ORDER(AQAOA(X))
IF X=""
QUIT
Begin DoDot:1
+24 IF AQAOA(X)[U
SET DR(2,$PIECE(AQAOA(X),U,2))=$PIECE(AQAOA(X),U,3)
+25 SET DR=DR_";"_$PIECE(AQAOA(X),U)
End DoDot:1
+26 ;user chose range by number
IF '$TEST
FOR
SET X=$PIECE(Y,",")
IF X=""
QUIT
Begin DoDot:1
+27 IF AQAOA(X)[U
SET DR(2,$PIECE(AQAOA(X),U,3))=$PIECE(AQAOA(X),U,2)
+28 SET X=$PIECE(AQAOA(X),U)
SET DR=DR_";"_X
+29 SET Y=$PIECE(Y,",",2,99)
End DoDot:1
+30 IF DR?1";".E
SET DR=$EXTRACT(DR,2,99)
+31 KILL DIE
SET DIE=9002167
SET DA=AQAOIFN
DO ^DIE
+32 ;
+33 SET AQAODIR=DIR("A")
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
+34 SET DIR("A")="Do you wish to EDIT this category again"
DO ^DIR
KILL DIR
+35 IF Y=1
SET AQAOTM=0
SET DIR("A")=AQAODIR
KILL AQAODIR
WRITE !!
GOTO ITEMFIND
+36 QUIT
+37 ; >>end of ITEMFIND subrtn<<
+38 ;
+39 ;
+40 ;
MULTFIND ; >>SUBRTN to display multiple entries in linked files<<
+1 ; >>> set variables about linked file
+2 ;file#, fields to edit
SET AQAOFL=$PIECE(AQAOSTR,U)
SET AQAOFLD=$PIECE(AQAOSTR,U,2)
+3 ;global node for file
SET AQAOGBL=^DIC(AQAOFL,0,"GL")
+4 ;set global xref
SET AQAOXX=0
SET AQAOXY=AQAOGBL_"""AB"",AQAOIFN,AQAOXX)"
+5 ;
+6 ;print screen heading
SET AQAOQUIT=0
WRITE !!!,"<<",AQAOPTL,">>",!
+7 ;special rtn for screen
SET X=$GET(^AQAQX(AQAOPT,"PG",AQAOSN,2))
IF X]""
XECUTE X
+8 ;special rtn found cause to quit edit of this screen
IF AQAOQUIT=1
QUIT
+9 ;
+10 ; >>> loop thru entries in linked file and display them by #
+11 SET (AQAOXX,AQAOCNT)=0
+12 FOR
SET AQAOXX=$ORDER(@AQAOXY)
IF AQAOXX'=+AQAOXX
QUIT
Begin DoDot:1
+13 ;.01 field of linked file
SET AQAOTM=$PIECE(@(AQAOGBL_"AQAOXX,0)"),U)
+14 SET AQAOCNT=AQAOCNT+1
SET AQAOA(AQAOCNT)=AQAOXX
+15 SET Y=AQAOTM
SET C=$PIECE(^DD(AQAOFL,.01,0),U,2)
DO Y^DIQ
+16 WRITE !,AQAOCNT,") ",Y
+17 ;identifier code
SET X=$GET(^AQAQX(AQAOPT,"PG",AQAOSN,4))
IF X[""
XECUTE X
+18 QUIT
End DoDot:1
+19 ;
+20 ; >>> last number is choice to add new entry
+21 IF AQAOCNT=0
DO ADD
IF $ORDER(@AQAOXY)
GOTO MULTFIND
QUIT
+22 SET AQAOCNT=AQAOCNT+1
WRITE !,AQAOCNT,") ADD NEW ENTRY"
+23 ;
CHOOSE ; >>> choose item(s) to edit
+1 WRITE !
SET DIR(0)="NO^1:"_AQAOCNT
SET DIR("?")="Choose from list above"
+2 DO ^DIR
IF X=""
QUIT
IF $DATA(DIRUT)
QUIT
IF Y=-1
GOTO CHOOSE
+3 IF (+Y=AQAOCNT)
DO ADD
GOTO MULTFIND
+4 IF '$TEST
SET DA=AQAOA(+Y)
DO EDIT
GOTO MULTFIND
+5 ;
ADD ;add new entry to subfile or edit entries already there
+1 KILL DIC
SET DIE="^AQAOC("
SET DLAYGO=AQAOFL
SET DA=AQAOIFN
+2 SET DR=AQAOFLD_" ADD]"
DO ^DIE
WRITE !
QUIT
+3 ;
EDIT ; >>> edit entries
+1 KILL DIC,DIE
SET DIE=AQAOGBL
SET DIDEL=AQAOFL
+2 SET DR=AQAOFLD_" EDIT]"
DO ^DIE
WRITE !
QUIT
+3 ;
+4 ; >>end of MULTFIND subrtn<<
