ACMCTRL ; IHS/TUCSON/TMJ - REGISTER CONTROL ; [ 02/10/2009 9:45 AM ]
;;2.0;ACM CASE MANAGEMENT SYSTEM;**4,8**;JAN 10, 1996
;CONTROLS WHICH DATA TYPES ARE INCLUDED FOR REGISTER
;ACMCRTL = DATA TYPES OVERALL
;ACMCTRLE = TYPES FOR PATIENT EDIT
;ACMCTRLS = TYPES FOR REGISTER SYSTEM EDIT
;ACMCTRLP = TYPES TO PRINT REGISTER SPECIFIC PATIENT REPORTS
;ACMCTRLX = TYPES TO PRINT REGISTER REPORTS
EN ;PEP - get register data
K ACMCTRL,ACMCTRLE,ACMCTRLP,ACMCTRLS,ACMCTRLX
D CONTROL,SET,EXIT
Q
;
EXIT F ACMX="","E","S","P","X" S ACMZZZ=@("ACMCTRL"_ACMX) I ACMZZZ[";;" S ACMZZZ=$P(ACMZZZ,";;")_";"_$P(ACMZZZ,";;",2),@("ACMCTRL"_ACMX)=ACMZZZ
K ACMES,ACMEP,ACMPS,ACMPP,ACMX,ACMY,ACMZ,ACMZZ,ACMZZZ
Q
;
CONTROL ;PEP - register setup?
I '$D(^ACM(41.1,ACMRG,0)) W *7,!!?10,"This register is not properly configured.",!?10,"Contact the Case Management Systems manager for assistance." R !!,"Strike <CR> to continue. ",ACMX:DTIME S ACMQUIT="" Q
S ACMX=""
F ACMI=0:0 S ACMX=$O(^ACM(41.1,ACMRG,2,"B",ACMX)) Q:ACMX="" S ACMZ=$P(^ACM(56,ACMX,0),U,3),ACMZ(ACMZ)=""
K ACMI
S (ACMCTRL,ACMY)=""
F ACMI=0:0 S ACMY=$O(ACMZ(ACMY)) Q:ACMY="" S ACMZZ=$O(^ACM(56,"C",ACMY,"")) S ACMCTRL=ACMCTRL_";"_$P(^ACM(56,ACMZZ,0),U,2)
K ACMI
S:$E(ACMCTRL,$L(ACMCTRL))'=";" ACMCTRL=ACMCTRL_";"
Q
;
SET S ACMCTRL1=ACMCTRL
F ACMI="ESDT","EPDT" S ACMCTRL=ACMCTRL1 D @ACMI
K ACMI,ACMCTRL1
S ACMCTRLS=ACMCTRLS_";AD",ACMCTRLE=ACMCTRLE_";AD"
Q
;
ESDT I ACMCTRL["CMGT" S ACMCTRL=$P(ACMCTRL,";CMGT")_$P(ACMCTRL,"CMGT",2,99) ;IHS/CIM/THL PATCH 4
I ACMCTRL["REG" S ACMCTRL=$P(ACMCTRL,";REG")_$P(ACMCTRL,"REG",2,99)
I ACMCTRL["DX" S ACMCTRL=$P(ACMCTRL,"DX")_"DXL"_$P(ACMCTRL,"DX",2,99)
I ACMCTRL["ET" S ACMCTRL=$P(ACMCTRL,"ET")_"ETL"_$P(ACMCTRL,"ET",2,99)
I ACMCTRL["DC" S ACMCTRL=$P(ACMCTRL,"DC")_"DCL"_$P(ACMCTRL,"DC",2,99)
I ACMCTRL["CMP" S ACMCTRL=$P(ACMCTRL,"CMP")_"CMPL"_$P(ACMCTRL,"CMP",2,99)
I ACMCTRL["RF" S ACMCTRL=$P(ACMCTRL,"RF")_"RFL"_$P(ACMCTRL,"RF",2,99)
I ACMCTRL["AP;" S ACMCTRL=$P(ACMCTRL,"AP;")_"APL;"_$P(ACMCTRL,"AP;",2,99)
I ACMCTRL["SV" S ACMCTRL=$P(ACMCTRL,"SV")_"SVL"_$P(ACMCTRL,"SV",2,99)
I ACMCTRL["MD" S ACMCTRL=$P(ACMCTRL,"MD")_"MDL"_$P(ACMCTRL,"MD",2,99)
I ACMCTRL["PROB" S ACMCTRL=$P(ACMCTRL,";PROB")_$P(ACMCTRL,";PROB",2,99)
I ACMCTRL["APPT" S ACMCTRL=$P(ACMCTRL,";APPT")_$P(ACMCTRL,";APPT",2,99)
I ACMCTRL["CT" S ACMCTRL=$P(ACMCTRL,";CT")_$P(ACMCTRL,";CT",2,99)
I ACMCTRL["FM" S ACMCTRL=$P(ACMCTRL,";FM")_$P(ACMCTRL,";FM",2,99)
I ACMCTRL["CR" S ACMCTRL=$P(ACMCTRL,";CR")_$P(ACMCTRL,";CR",2,99)
I ACMCTRL["CP" S ACMCTRL=$P(ACMCTRL,";CP")_$P(ACMCTRL,";CP",2,99)
I ACMCTRL["CH",ACMCTRL'["DML" S ACMCTRL=$P(ACMCTRL,";CH")_$P(ACMCTRL,";CH",2,99)_""
I ACMCTRL["MEAS" S ACMCTRL=$P(ACMCTRL,"MEAS")_"MEAS"_$P(ACMCTRL,"MEAS",2,99)
;I ACMCTRL'["RD" S ACMCTRL=ACMCTRL_"RD;"
I ACMCTRL["RD",ACMCTRL'["SV" S ACMCTRL=ACMCTRL_"SVL;"
S:$E(ACMCTRL)=";" ACMCTRL=$P(ACMCTRL,";",2,999)
S:$E(ACMCTRL,$L(ACMCTRL))=";" ACMCTRL=$E(ACMCTRL,1,$L(ACMCTRL)-1)
S (ACMCTRLS,ACMCTRLX)=ACMCTRL
S ACMCTRLS=$P(ACMCTRLS,";MEAS")_$P(ACMCTRLS,";MEAS",2,99)
;S ACMCTRLS=$P(ACMCTRLS,";APPT")_$P(ACMCTRLS,";APPT",2,99)
S ACMCTRLS=$P(ACMCTRLS,";CH")_$P(ACMCTRLS,";CH",2,99)
S:ACMCTRLS[";DC;" ACMCTRLS=$P(ACMCTRLS,";DC;")_";DCL;"_$P(ACMCTRLS,";DC;",2,99)
Q
;
EPDT I ACMCTRL'["REG" S ACMCTRL=";REG;"_ACMCTRL
I ACMCTRL'["CR" S ACMCTRL=ACMCTRL_"CR;"
I ACMCTRL["RD",ACMCTRL'["SV" S ACMCTRL=ACMCTRL_"SV;"
S:$E(ACMCTRL)=";" ACMCTRL=$P(ACMCTRL,";",2,999)
S:$E(ACMCTRL,$L(ACMCTRL))=";" ACMCTRL=$E(ACMCTRL,1,$L(ACMCTRL)-1)
S (ACMCTRLE,ACMCTRLP)=ACMCTRL
;S:ACMCTRLP'["APPL" ACMCTRLP=$P(ACMCTRLP,";APPT")_";APPT"_$P(ACMCTRL,";APPT",2)
I ACMCTRLP["PROB",$P(^ACM(41.1,ACMRG,0),U,10)=0 S ACMCTRLP=$P(ACMCTRLP,"PROB;",2)
Q
ACMCTRL ; IHS/TUCSON/TMJ - REGISTER CONTROL ; [ 02/10/2009 9:45 AM ]
+1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**4,8**;JAN 10, 1996
+2 ;CONTROLS WHICH DATA TYPES ARE INCLUDED FOR REGISTER
+3 ;ACMCRTL = DATA TYPES OVERALL
+4 ;ACMCTRLE = TYPES FOR PATIENT EDIT
+5 ;ACMCTRLS = TYPES FOR REGISTER SYSTEM EDIT
+6 ;ACMCTRLP = TYPES TO PRINT REGISTER SPECIFIC PATIENT REPORTS
+7 ;ACMCTRLX = TYPES TO PRINT REGISTER REPORTS
EN ;PEP - get register data
+1 KILL ACMCTRL,ACMCTRLE,ACMCTRLP,ACMCTRLS,ACMCTRLX
+2 DO CONTROL
DO SET
DO EXIT
+3 QUIT
+4 ;
EXIT FOR ACMX="","E","S","P","X"
SET ACMZZZ=@("ACMCTRL"_ACMX)
IF ACMZZZ[";;"
SET ACMZZZ=$PIECE(ACMZZZ,";;")_";"_$PIECE(ACMZZZ,";;",2)
SET @("ACMCTRL"_ACMX)=ACMZZZ
+1 KILL ACMES,ACMEP,ACMPS,ACMPP,ACMX,ACMY,ACMZ,ACMZZ,ACMZZZ
+2 QUIT
+3 ;
CONTROL ;PEP - register setup?
+1 IF '$DATA(^ACM(41.1,ACMRG,0))
WRITE *7,!!?10,"This register is not properly configured.",!?10,"Contact the Case Management Systems manager for assistance."
READ !!,"Strike <CR> to continue. ",ACMX:DTIME
SET ACMQUIT=""
QUIT
+2 SET ACMX=""
+3 FOR ACMI=0:0
SET ACMX=$ORDER(^ACM(41.1,ACMRG,2,"B",ACMX))
IF ACMX=""
QUIT
SET ACMZ=$PIECE(^ACM(56,ACMX,0),U,3)
SET ACMZ(ACMZ)=""
+4 KILL ACMI
+5 SET (ACMCTRL,ACMY)=""
+6 FOR ACMI=0:0
SET ACMY=$ORDER(ACMZ(ACMY))
IF ACMY=""
QUIT
SET ACMZZ=$ORDER(^ACM(56,"C",ACMY,""))
SET ACMCTRL=ACMCTRL_";"_$PIECE(^ACM(56,ACMZZ,0),U,2)
+7 KILL ACMI
+8 IF $EXTRACT(ACMCTRL,$LENGTH(ACMCTRL))'=";"
SET ACMCTRL=ACMCTRL_";"
+9 QUIT
+10 ;
SET SET ACMCTRL1=ACMCTRL
+1 FOR ACMI="ESDT","EPDT"
SET ACMCTRL=ACMCTRL1
DO @ACMI
+2 KILL ACMI,ACMCTRL1
+3 SET ACMCTRLS=ACMCTRLS_";AD"
SET ACMCTRLE=ACMCTRLE_";AD"
+4 QUIT
+5 ;
ESDT ;IHS/CIM/THL PATCH 4
IF ACMCTRL["CMGT"
SET ACMCTRL=$PIECE(ACMCTRL,";CMGT")_$PIECE(ACMCTRL,"CMGT",2,99)
+1 IF ACMCTRL["REG"
SET ACMCTRL=$PIECE(ACMCTRL,";REG")_$PIECE(ACMCTRL,"REG",2,99)
+2 IF ACMCTRL["DX"
SET ACMCTRL=$PIECE(ACMCTRL,"DX")_"DXL"_$PIECE(ACMCTRL,"DX",2,99)
+3 IF ACMCTRL["ET"
SET ACMCTRL=$PIECE(ACMCTRL,"ET")_"ETL"_$PIECE(ACMCTRL,"ET",2,99)
+4 IF ACMCTRL["DC"
SET ACMCTRL=$PIECE(ACMCTRL,"DC")_"DCL"_$PIECE(ACMCTRL,"DC",2,99)
+5 IF ACMCTRL["CMP"
SET ACMCTRL=$PIECE(ACMCTRL,"CMP")_"CMPL"_$PIECE(ACMCTRL,"CMP",2,99)
+6 IF ACMCTRL["RF"
SET ACMCTRL=$PIECE(ACMCTRL,"RF")_"RFL"_$PIECE(ACMCTRL,"RF",2,99)
+7 IF ACMCTRL["AP;"
SET ACMCTRL=$PIECE(ACMCTRL,"AP;")_"APL;"_$PIECE(ACMCTRL,"AP;",2,99)
+8 IF ACMCTRL["SV"
SET ACMCTRL=$PIECE(ACMCTRL,"SV")_"SVL"_$PIECE(ACMCTRL,"SV",2,99)
+9 IF ACMCTRL["MD"
SET ACMCTRL=$PIECE(ACMCTRL,"MD")_"MDL"_$PIECE(ACMCTRL,"MD",2,99)
+10 IF ACMCTRL["PROB"
SET ACMCTRL=$PIECE(ACMCTRL,";PROB")_$PIECE(ACMCTRL,";PROB",2,99)
+11 IF ACMCTRL["APPT"
SET ACMCTRL=$PIECE(ACMCTRL,";APPT")_$PIECE(ACMCTRL,";APPT",2,99)
+12 IF ACMCTRL["CT"
SET ACMCTRL=$PIECE(ACMCTRL,";CT")_$PIECE(ACMCTRL,";CT",2,99)
+13 IF ACMCTRL["FM"
SET ACMCTRL=$PIECE(ACMCTRL,";FM")_$PIECE(ACMCTRL,";FM",2,99)
+14 IF ACMCTRL["CR"
SET ACMCTRL=$PIECE(ACMCTRL,";CR")_$PIECE(ACMCTRL,";CR",2,99)
+15 IF ACMCTRL["CP"
SET ACMCTRL=$PIECE(ACMCTRL,";CP")_$PIECE(ACMCTRL,";CP",2,99)
+16 IF ACMCTRL["CH"
IF ACMCTRL'["DML"
SET ACMCTRL=$PIECE(ACMCTRL,";CH")_$PIECE(ACMCTRL,";CH",2,99)_""
+17 IF ACMCTRL["MEAS"
SET ACMCTRL=$PIECE(ACMCTRL,"MEAS")_"MEAS"_$PIECE(ACMCTRL,"MEAS",2,99)
+18 ;I ACMCTRL'["RD" S ACMCTRL=ACMCTRL_"RD;"
+19 IF ACMCTRL["RD"
IF ACMCTRL'["SV"
SET ACMCTRL=ACMCTRL_"SVL;"
+20 IF $EXTRACT(ACMCTRL)=";"
SET ACMCTRL=$PIECE(ACMCTRL,";",2,999)
+21 IF $EXTRACT(ACMCTRL,$LENGTH(ACMCTRL))=";"
SET ACMCTRL=$EXTRACT(ACMCTRL,1,$LENGTH(ACMCTRL)-1)
+22 SET (ACMCTRLS,ACMCTRLX)=ACMCTRL
+23 SET ACMCTRLS=$PIECE(ACMCTRLS,";MEAS")_$PIECE(ACMCTRLS,";MEAS",2,99)
+24 ;S ACMCTRLS=$P(ACMCTRLS,";APPT")_$P(ACMCTRLS,";APPT",2,99)
+25 SET ACMCTRLS=$PIECE(ACMCTRLS,";CH")_$PIECE(ACMCTRLS,";CH",2,99)
+26 IF ACMCTRLS[";DC;"
SET ACMCTRLS=$PIECE(ACMCTRLS,";DC;")_";DCL;"_$PIECE(ACMCTRLS,";DC;",2,99)
+27 QUIT
+28 ;
EPDT IF ACMCTRL'["REG"
SET ACMCTRL=";REG;"_ACMCTRL
+1 IF ACMCTRL'["CR"
SET ACMCTRL=ACMCTRL_"CR;"
+2 IF ACMCTRL["RD"
IF ACMCTRL'["SV"
SET ACMCTRL=ACMCTRL_"SV;"
+3 IF $EXTRACT(ACMCTRL)=";"
SET ACMCTRL=$PIECE(ACMCTRL,";",2,999)
+4 IF $EXTRACT(ACMCTRL,$LENGTH(ACMCTRL))=";"
SET ACMCTRL=$EXTRACT(ACMCTRL,1,$LENGTH(ACMCTRL)-1)
+5 SET (ACMCTRLE,ACMCTRLP)=ACMCTRL
+6 ;S:ACMCTRLP'["APPL" ACMCTRLP=$P(ACMCTRLP,";APPT")_";APPT"_$P(ACMCTRL,";APPT",2)
+7 IF ACMCTRLP["PROB"
IF $PIECE(^ACM(41.1,ACMRG,0),U,10)=0
SET ACMCTRLP=$PIECE(ACMCTRLP,"PROB;",2)
+8 QUIT
