APCLFS1.m

APCLFS1 ; IHS/CMI/LAB - DMS FLOW SHEET MANAGEMENT UTILITY ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;UTILITY PROGRAM TO MANAGE FLOW SHEET CREATION AND EDITING

CSADD ;EP;ADD CLINIC STOP

 W @IOF

 W !?5,"Select CLINIC to add to the"

 W !?5,APCLSNAM,?25,"Flow Sheet"

 S DIC="^DIC(40.7,"

 S DIC(0)="AEMQZ"

 S DIC("A")="Which CLINIC: "

 W !

 D DIC^APCLDIC

 Q:+Y<1

 S (DINUM,X)=+Y

 S DA(1)=APCLSDA

 S DIC="^APCHSFLC("_APCLSDA_",3,"

 S DIC(0)="L"

 D FILE^APCLDIC

 D CSBACK

 Q

CSDEL ;EP;DELETE CLINIC STOP

 N APCLY

 D CSSEL

 I $D(APCLQUIT) K APCLQUIT D FSCBACK^APCLFS Q

 F APCLI=1:1 S APCLX=$P(APCLY,",",APCLI) Q:APCLX=""  D

 .Q:'$D(APCLCS(APCLSDA,APCLX))

 .S DA=$P(APCLCS(APCLSDA,APCLX),U,2)

 .S DA(1)=APCLSDA

 .S DIK="^APCHSFLC("_DA(1)_",3,"

 .D DIK^APCLDIC

CSBACK S APCLGO="FSC"

 D BACK^APCLFS

 Q

CSSEL ;SELECT CLINIC STOP

 S DIR(0)="LO^1:"_APCLCS

 S DIR("A")="Whick Clinic Stop(s)"

 W !

 D DIR^APCLDIC

 I Y<1 S APCLQUIT="" Q

 S APCLY=Y

 Q

APCLFS1   ; IHS/CMI/LAB - DMS FLOW SHEET MANAGEMENT UTILITY ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;UTILITY PROGRAM TO MANAGE FLOW SHEET CREATION AND EDITING

CSADD     ;EP;ADD CLINIC STOP

 +1        WRITE @IOF

 +2        WRITE !?5,"Select CLINIC to add to the"

 +3        WRITE !?5,APCLSNAM,?25,"Flow Sheet"

 +4        SET DIC="^DIC(40.7,"

 +5        SET DIC(0)="AEMQZ"

 +6        SET DIC("A")="Which CLINIC: "

 +7        WRITE !

 +8        DO DIC^APCLDIC

 +9        IF +Y<1

               QUIT 

 +10       SET (DINUM,X)=+Y

 +11       SET DA(1)=APCLSDA

 +12       SET DIC="^APCHSFLC("_APCLSDA_",3,"

 +13       SET DIC(0)="L"

 +14       DO FILE^APCLDIC

 +15       DO CSBACK

 +16       QUIT 

CSDEL     ;EP;DELETE CLINIC STOP

 +1        NEW APCLY

 +2        DO CSSEL

 +3        IF $DATA(APCLQUIT)

               KILL APCLQUIT

               DO FSCBACK^APCLFS

               QUIT 

 +4        FOR APCLI=1:1

               SET APCLX=$PIECE(APCLY,",",APCLI)

               IF APCLX=""

                   QUIT 

               Begin DoDot:1

 +5                IF '$DATA(APCLCS(APCLSDA,APCLX))

                       QUIT 

 +6                SET DA=$PIECE(APCLCS(APCLSDA,APCLX),U,2)

 +7                SET DA(1)=APCLSDA

 +8                SET DIK="^APCHSFLC("_DA(1)_",3,"

 +9                DO DIK^APCLDIC

               End DoDot:1

CSBACK     SET APCLGO="FSC"

 +1        DO BACK^APCLFS

 +2        QUIT 

CSSEL     ;SELECT CLINIC STOP

 +1        SET DIR(0)="LO^1:"_APCLCS

 +2        SET DIR("A")="Whick Clinic Stop(s)"

 +3        WRITE !

 +4        DO DIR^APCLDIC

 +5        IF Y<1

               SET APCLQUIT=""

               QUIT 

 +6        SET APCLY=Y

 +7        QUIT