Routine: ACMCTRL

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

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

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_";"

SET S ACMCTRL1=ACMCTRL

 F ACMI="ESDT","EPDT" S ACMCTRL=ACMCTRL1 D @ACMI

 K ACMI,ACMCTRL1

 S ACMCTRLS=ACMCTRLS_";AD",ACMCTRLE=ACMCTRLE_";AD"

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)

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)

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

ACMCTRL.m