- ACMQK ; IHS/TUCSON/TMJ - EDIT/PRINT/SORT CONTROLS ; [ 03/11/2002 6:59 PM ]
- ;;2.0;ACM CASE MANAGEMENT SYSTEM;**5,8**;JAN 10, 1996
- ;ACMCTRLE OR ACMCTRLS OR ACMCTRLP OR ACMCTRLX VARIABLES
- EN ;PEP - SORT CONTROLS
- Q:'$D(ACMRG)!$D(XQUIT)
- D SLCT
- EXIT K ACMX,ACMRTN,ACMLINER,ACMSLCT,ACMENTRY,ACMDATA,ACMEN,ACMJ,ACM,ACMQKI,ACMLI,ACMEND,ACMQK1,ACMCNT,ACMTITLE,ACMOUT,ACMENDD,%
- Q
- ;
- SLCT S ACMTITLE=$S($D(ACMES):"LSS",$D(ACMEP):"PDE",$D(ACMPS):"PSD",$D(ACMPP):"PR",1:"HEAD")
- D @ACMTITLE^ACMMENU
- W !
- S ACMCTRL=$S($D(ACMEP):ACMCTRLE,$D(ACMES):ACMCTRLS,$D(ACMPP):ACMCTRLP,$D(ACMPS):ACMCTRLX,1:"")
- Q:ACMCTRL=""
- I ACMCTRLS=";AD",$D(ACMES) W !,?5,"The "_ACMRGNA_" Register does NOT include any Data Type Component",!,?5,"which requires a Supporting List to be built!",! H 8 Q
- S ACMEND=$L(ACMCTRL,";"),ACMENDD=ACMEND\2+(ACMEND#2)
- K ACM
- F %(1)=1:1:ACMEND S ACMEN=$P(ACMCTRL,";",%(1)),ACMDATA=$T(@ACMEN^ACMCTRL1),ACMSLCT=$P(ACMDATA,";;",2),ACM(%(1))=ACMDATA
- F %(1)=1:1:ACMENDD D
- .S ACMDATA=ACM(%(1)),ACMSLCT=$P(ACMDATA,";;",2) W !?10,$J(%(1)_")",3),?$X+2,ACMSLCT
- .S %(2)=%(1)+ACMENDD
- .Q:'$D(ACM(%(2)))
- .S ACMDATA=ACM(%(2)),ACMSLCT=$P(ACMDATA,";;",2) W ?45,$J(%(2)_")",3),?$X+2,ACMSLCT
- SLCT1 W !
- W:'$D(ACMPP) !?10,"To select several options separate them with commas.",!?10,"For example: ==> 1,3,7,9 "
- W !
- S DIR(0)="LOA^1:"_ACMEND,DIR("A")=" "_$S($D(ACMES)!$D(ACMEP):"Enter",$D(ACMPS)!$D(ACMPP):"Report")_" Option"_$S('$D(ACMPP):"(s)",1:"")_" ==> ",DIR("?")="Type a number from 1 to "_ACMEND
- D ^DIR K DIR
- I U[$E(X)!(Y="") K:$D(ACMES) ACMCTRL S ACMQUIT="" Q
- S ACMQK=Y
- S:$E(ACMQK,$L(ACMQK))="," ACMQK=$E(ACMQK,1,$L(ACMQK)-1)
- I $D(ACMPP) S ACMENTRY=ACM(ACMQK) D ^ACMSRT G EN
- I ACMQK=ACMEND D ALL G EN
- D LOOP
- G EN
- ;
- LOOP S ACMCNT=$L(ACMQK,","),ACMQK1=ACMQK
- F ACMLI=1:1:ACMCNT S ACMQK=$P(ACMQK1,",",ACMLI) D:ACMQK?1N.2N&(ACMQK'>(ACMEND-1)) SET Q:$D(ACMOUT)
- Q
- ;
- SET Q:ACMQK=ACMEND
- S ACMENTRY=ACM(ACMQK),ACMRTN=$S($D(ACMES):"^ACMESDT",$D(ACMEP):"^ACMEP",$D(ACMPS)!$D(ACMPP):"^ACMSRT")
- I $P(ACMENTRY," ;;")="APPT" S ACMRTN="^ACMAPPT"
- I $P(ACMENTRY," ;;")="CT" S ACMCT=""
- I $P(ACMENTRY," ;;")="CH" S ACMCH=""
- I $P(ACMENTRY," ;;")="CR" S ACMCR=""
- I $P(ACMENTRY," ;;")="CP" S ACMRTN="^ACMPLAN"
- I $P(ACMENTRY," ;;")="CMGT" S ACMRTN="CMS^CIMTYKC" ;IHS/CIM/THL PATCH 5
- D @ACMRTN
- K ACMRTN,ACMCT,ACMCH,ACMCR
- Q
- ;
- ALL ;
- F ACMQK=1:1:(ACMEND-1) D SET Q:$D(ACMOUT)
- Q
- ACMQK ; IHS/TUCSON/TMJ - EDIT/PRINT/SORT CONTROLS ; [ 03/11/2002 6:59 PM ]
- +1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**5,8**;JAN 10, 1996
- +2 ;ACMCTRLE OR ACMCTRLS OR ACMCTRLP OR ACMCTRLX VARIABLES
- EN ;PEP - SORT CONTROLS
- +1 IF '$DATA(ACMRG)!$DATA(XQUIT)
- QUIT
- +2 DO SLCT
- EXIT KILL ACMX,ACMRTN,ACMLINER,ACMSLCT,ACMENTRY,ACMDATA,ACMEN,ACMJ,ACM,ACMQKI,ACMLI,ACMEND,ACMQK1,ACMCNT,ACMTITLE,ACMOUT,ACMENDD,%
- +1 QUIT
- +2 ;
- SLCT SET ACMTITLE=$SELECT($DATA(ACMES):"LSS",$DATA(ACMEP):"PDE",$DATA(ACMPS):"PSD",$DATA(ACMPP):"PR",1:"HEAD")
- +1 DO @ACMTITLE^ACMMENU
- +2 WRITE !
- +3 SET ACMCTRL=$SELECT($DATA(ACMEP):ACMCTRLE,$DATA(ACMES):ACMCTRLS,$DATA(ACMPP):ACMCTRLP,$DATA(ACMPS):ACMCTRLX,1:"")
- +4 IF ACMCTRL=""
- QUIT
- +5 IF ACMCTRLS=";AD"
- IF $DATA(ACMES)
- WRITE !,?5,"The "_ACMRGNA_" Register does NOT include any Data Type Component",!,?5,"which requires a Supporting List to be built!",!
- HANG 8
- QUIT
- +6 SET ACMEND=$LENGTH(ACMCTRL,";")
- SET ACMENDD=ACMEND\2+(ACMEND#2)
- +7 KILL ACM
- +8 FOR %(1)=1:1:ACMEND
- SET ACMEN=$PIECE(ACMCTRL,";",%(1))
- SET ACMDATA=$TEXT(@ACMEN^ACMCTRL1)
- SET ACMSLCT=$PIECE(ACMDATA,";;",2)
- SET ACM(%(1))=ACMDATA
- +9 FOR %(1)=1:1:ACMENDD
- Begin DoDot:1
- +10 SET ACMDATA=ACM(%(1))
- SET ACMSLCT=$PIECE(ACMDATA,";;",2)
- WRITE !?10,$JUSTIFY(%(1)_")",3),?$X+2,ACMSLCT
- +11 SET %(2)=%(1)+ACMENDD
- +12 IF '$DATA(ACM(%(2)))
- QUIT
- +13 SET ACMDATA=ACM(%(2))
- SET ACMSLCT=$PIECE(ACMDATA,";;",2)
- WRITE ?45,$JUSTIFY(%(2)_")",3),?$X+2,ACMSLCT
- End DoDot:1
- SLCT1 WRITE !
- +1 IF '$DATA(ACMPP)
- WRITE !?10,"To select several options separate them with commas.",!?10,"For example: ==> 1,3,7,9 "
- +2 WRITE !
- +3 SET DIR(0)="LOA^1:"_ACMEND
- SET DIR("A")=" "_$SELECT($DATA(ACMES)!$DATA(ACMEP):"Enter",$DATA(ACMPS)!$DATA(ACMPP):"Report")_" Option"_$SELECT('$DATA(ACMPP):"(s)",1:"")_" ==> "
- SET DIR("?")="Type a number from 1 to "_ACMEND
- +4 DO ^DIR
- KILL DIR
- +5 IF U[$EXTRACT(X)!(Y="")
- IF $DATA(ACMES)
- KILL ACMCTRL
- SET ACMQUIT=""
- QUIT
- +6 SET ACMQK=Y
- +7 IF $EXTRACT(ACMQK,$LENGTH(ACMQK))=","
- SET ACMQK=$EXTRACT(ACMQK,1,$LENGTH(ACMQK)-1)
- +8 IF $DATA(ACMPP)
- SET ACMENTRY=ACM(ACMQK)
- DO ^ACMSRT
- GOTO EN
- +9 IF ACMQK=ACMEND
- DO ALL
- GOTO EN
- +10 DO LOOP
- +11 GOTO EN
- +12 ;
- LOOP SET ACMCNT=$LENGTH(ACMQK,",")
- SET ACMQK1=ACMQK
- +1 FOR ACMLI=1:1:ACMCNT
- SET ACMQK=$PIECE(ACMQK1,",",ACMLI)
- IF ACMQK?1N.2N&(ACMQK'>(ACMEND-1))
- DO SET
- IF $DATA(ACMOUT)
- QUIT
- +2 QUIT
- +3 ;
- SET IF ACMQK=ACMEND
- QUIT
- +1 SET ACMENTRY=ACM(ACMQK)
- SET ACMRTN=$SELECT($DATA(ACMES):"^ACMESDT",$DATA(ACMEP):"^ACMEP",$DATA(ACMPS)!$DATA(ACMPP):"^ACMSRT")
- +2 IF $PIECE(ACMENTRY," ;;")="APPT"
- SET ACMRTN="^ACMAPPT"
- +3 IF $PIECE(ACMENTRY," ;;")="CT"
- SET ACMCT=""
- +4 IF $PIECE(ACMENTRY," ;;")="CH"
- SET ACMCH=""
- +5 IF $PIECE(ACMENTRY," ;;")="CR"
- SET ACMCR=""
- +6 IF $PIECE(ACMENTRY," ;;")="CP"
- SET ACMRTN="^ACMPLAN"
- +7 ;IHS/CIM/THL PATCH 5
- IF $PIECE(ACMENTRY," ;;")="CMGT"
- SET ACMRTN="CMS^CIMTYKC"
- +8 DO @ACMRTN
- +9 KILL ACMRTN,ACMCT,ACMCH,ACMCR
- +10 QUIT
- +11 ;
- ALL ;
- +1 FOR ACMQK=1:1:(ACMEND-1)
- DO SET
- IF $DATA(ACMOUT)
- QUIT
- +2 QUIT
