ACMED.m

ACMED ; IHS/TUCSON/TMJ - ADD/EDIT ACM FILES ;

 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**8**;JAN 10, 1996

 ;CONTROLLER FOR PATIENT DATA ENTRY AND INDIVIDUAL CASE SUMMARY

QK ;PEP;TO BEGIN QUICK DATA ENTRY SEQUENCE

 S ACMED("ACM")=""

 F ACMED("ACM")=1:1:3 D @$P("CURRENT;^ACMLPAT;^ACMQK",";",ACMED("ACM")) Q:$D(ACMQUIT)

 I $D(ACMQUIT),ACMQUIT="ACMQUIT" G EXIT

 E  K ACMQUIT G QK

 Q

QK1 S ACMED("ACM")=""

 F ACMED("ACM")=1:1:2 D @$P("CURRENT;^ACMQK",";",ACMED("ACM")) Q:$D(ACMQUIT)

 I $D(ACMQUIT),ACMQUIT="ACMQUIT" G EXIT

 E  K ACMQUIT G QK

 Q

QONE ;PEP;TO ADD PATIENT

 S ACMED("ACM")=""

 F ACMED("ACM")=1:1:3 D @$P("CURRENT;^ACMLPAT;^ACMPPDT",";",ACMED("ACM")) Q:$D(ACMQUIT)

 I $D(ACMQUIT),ACMQUIT="ACMQUIT" G EXIT

 E  K ACMQUIT G QONE

 Q

SLCT ;

 S ACMED("ACM")=""

 F ACMED("ACM")=1:1:2 D @$P("CURRENT;^ACMLPAT",";",ACMED("ACM")) Q:$D(ACMQUIT)

 I $D(ACMQUIT),ACMQUIT="ACMQUIT" G EXIT

 E  K ACMQUIT G SLCT

 Q

EXIT K ACMED("ACM"),ACMQUIT W:$D(IOF) @IOF

 Q

CLEAN ;EP;TO KILL OFF ALL VARIABLES

 K ACM,ACMTITLE,ACMENTRY,ACMEND,ACMRG,ACMRGNA,ACMQUIT,ACMPTNA,ACMPTNO

 K ACMTRM,ACMRVON,ACMRVOFF,ACMAGE,ACMMSRT,ACMCMGR,ACMDOB,ACMMGR,ACMPG

 K ACMSTAT,ACMALL,ACMCOMM,ACMINIT,ACMSEV,ACMWHER,^UTILITY("DIQ1",$J)

 K ACMRGTP,ACMCTRL,ACMCTRLE,ACMCTRLP,ACMCTRLS,ACMCTRLX,ACMDIC1,ACMPHN

 K ACMAA,ACMI,APPREFIX,DIC,DIE,DIQ,DIQ1,DA,DR,ACMPAGE,ACMPC,ACMPCCHS

 K ACMPRV,ACMSTYP,ACMU2,ACMUA,ACMZ,ACMLINER,ACMYZ,ACMYX,ACMBY1,ACMBY2

 K ACMCNT,ACMYY,ACMYI,ACMYL,ACMRGDFN,ACMLETR,ACMMHS,ACMRSRG,ACMSITE

 K ACMSVPD,ACMPTDEL,ACMMIFN,ACMCSTG,ACMFILE,ACMMAND,ACMN,ACMPTMP

 K ACMRPT,ACMUB

 Q

CURRENT ;EP;TO SET SCREEN HANDLING VARIABLES

 S IOP="HOME" D ^%ZIS K IOP

 I $D(IOST(0)) S ACMTRM=$S($D(^%ZIS(2,IOST(0),5)):^(5),1:X),ACMRVON=$S($P(ACMTRM,U,4)'="":$P(ACMTRM,U,4),1:""),ACMRVOFF=$S($P(ACMTRM,U,5)'="":$P(ACMTRM,U,5),1:"")

 S:'$D(ACMRVON) (ACMRVON,ACMRVOFF)=""

 Q

ACMED     ; IHS/TUCSON/TMJ - ADD/EDIT ACM FILES ;

 +1       ;;2.0;ACM CASE MANAGEMENT SYSTEM;**8**;JAN 10, 1996

 +2       ;CONTROLLER FOR PATIENT DATA ENTRY AND INDIVIDUAL CASE SUMMARY

QK        ;PEP;TO BEGIN QUICK DATA ENTRY SEQUENCE

 +1        SET ACMED("ACM")=""

 +2        FOR ACMED("ACM")=1:1:3

               DO @$PIECE("CURRENT;^ACMLPAT;^ACMQK",";",ACMED("ACM"))

               IF $DATA(ACMQUIT)

                   QUIT 

 +3        IF $DATA(ACMQUIT)

               IF ACMQUIT="ACMQUIT"

                   GOTO EXIT

 +4       IF '$TEST

               KILL ACMQUIT

               GOTO QK

 +5        QUIT 

QK1        SET ACMED("ACM")=""

 +1        FOR ACMED("ACM")=1:1:2

               DO @$PIECE("CURRENT;^ACMQK",";",ACMED("ACM"))

               IF $DATA(ACMQUIT)

                   QUIT 

 +2        IF $DATA(ACMQUIT)

               IF ACMQUIT="ACMQUIT"

                   GOTO EXIT

 +3       IF '$TEST

               KILL ACMQUIT

               GOTO QK

 +4        QUIT 

QONE      ;PEP;TO ADD PATIENT

 +1        SET ACMED("ACM")=""

 +2        FOR ACMED("ACM")=1:1:3

               DO @$PIECE("CURRENT;^ACMLPAT;^ACMPPDT",";",ACMED("ACM"))

               IF $DATA(ACMQUIT)

                   QUIT 

 +3        IF $DATA(ACMQUIT)

               IF ACMQUIT="ACMQUIT"

                   GOTO EXIT

 +4       IF '$TEST

               KILL ACMQUIT

               GOTO QONE

 +5        QUIT 

SLCT      ;

 +1        SET ACMED("ACM")=""

 +2        FOR ACMED("ACM")=1:1:2

               DO @$PIECE("CURRENT;^ACMLPAT",";",ACMED("ACM"))

               IF $DATA(ACMQUIT)

                   QUIT 

 +3        IF $DATA(ACMQUIT)

               IF ACMQUIT="ACMQUIT"

                   GOTO EXIT

 +4       IF '$TEST

               KILL ACMQUIT

               GOTO SLCT

 +5        QUIT 

EXIT       KILL ACMED("ACM"),ACMQUIT

           IF $DATA(IOF)

               WRITE @IOF

 +1        QUIT 

CLEAN     ;EP;TO KILL OFF ALL VARIABLES

 +1        KILL ACM,ACMTITLE,ACMENTRY,ACMEND,ACMRG,ACMRGNA,ACMQUIT,ACMPTNA,ACMPTNO

 +2        KILL ACMTRM,ACMRVON,ACMRVOFF,ACMAGE,ACMMSRT,ACMCMGR,ACMDOB,ACMMGR,ACMPG

 +3        KILL ACMSTAT,ACMALL,ACMCOMM,ACMINIT,ACMSEV,ACMWHER,^UTILITY("DIQ1",$JOB)

 +4        KILL ACMRGTP,ACMCTRL,ACMCTRLE,ACMCTRLP,ACMCTRLS,ACMCTRLX,ACMDIC1,ACMPHN

 +5        KILL ACMAA,ACMI,APPREFIX,DIC,DIE,DIQ,DIQ1,DA,DR,ACMPAGE,ACMPC,ACMPCCHS

 +6        KILL ACMPRV,ACMSTYP,ACMU2,ACMUA,ACMZ,ACMLINER,ACMYZ,ACMYX,ACMBY1,ACMBY2

 +7        KILL ACMCNT,ACMYY,ACMYI,ACMYL,ACMRGDFN,ACMLETR,ACMMHS,ACMRSRG,ACMSITE

 +8        KILL ACMSVPD,ACMPTDEL,ACMMIFN,ACMCSTG,ACMFILE,ACMMAND,ACMN,ACMPTMP

 +9        KILL ACMRPT,ACMUB

 +10       QUIT 

CURRENT   ;EP;TO SET SCREEN HANDLING VARIABLES

 +1        SET IOP="HOME"

           DO ^%ZIS

           KILL IOP

 +2        IF $DATA(IOST(0))

               SET ACMTRM=$SELECT($DATA(^%ZIS(2,IOST(0),5)):^(5),1:X)

               SET ACMRVON=$SELECT($PIECE(ACMTRM,U,4)'="":$PIECE(ACMTRM,U,4),1:"")

               SET ACMRVOFF=$SELECT($PIECE(ACMTRM,U,5)'="":$PIECE(ACMTRM,U,5),1:"")

 +3        IF '$DATA(ACMRVON)

               SET (ACMRVON,ACMRVOFF)=""

 +4        QUIT