APCLLTD.m

APCLLTD ; IHS/CMI/LAB - FILEMAN INTERFACE UTILITY ;

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

 ;;UTILITY ROUTINE USED TO MANAGE ALL INTERFACE TO FILEMAN

 ;;WITH FEW EXCEPTIONS, THIS IS THE ONLY PLACE IN ARMS FROM WHICH

 ;;FILEMAN ENTRY POINTS ARE CALLED

DIC ;EP;

 Q:$D(APCLLTOT)

 K DTOUT,DUOUT,APCLLTQT,APCLLTOT

 D ^DIC

 S:$D(DUOUT) APCLLTQT=""

 S:$D(DTOUT)!(X="^^") (APCLLTQT,APCLLTOT)=""

 K DIC,DA,DD,DR,DINUM,D,DLAYGO,DIADD ;IHS/CMI/THL PATCH 4 ADD 'DIADD' TO KILL LIST

 Q

MIX ;EP;

 Q:$D(APCLLTOT)

 K DTOUT,DUOUT,APCLLTQT,APCLLTOT

 D MIX^DIC1

 S:$D(DTOUT)!$D(DUOUT)!(X="^^") (APCLLTQT,APCLLTOT)=""

 K DIC,DA,DD,DR,DINUM,D,DLAYGO

 Q

IX ;EP;

 Q:$D(APCLLTOT)

 K DTOUT,DUOUT,APCLLTQT,APCLLTOT

 D IX^DIC

 S:$D(DTOUT)!$D(DUOUT)!(X="^^") (APCLLTQT,APCLLTOT)=""

 K DIC,DA,DD,DR,DINUM,D,DLAYGO

 Q

DIE ;EP;

 Q:$D(APCLLTOT)

 Q:'DA

 K DTOUT,DUOUT,APCLLTQT,APCLLTOT

 L +@(DIE_DA_")"):4 I '$T S APCLLTQT="" Q:'$D(IOST)#2  W:$E(IOST,1,2)="C-" !!,"Entry being edited by another user.  Please try Later.",! H 3 Q

 S APCLDIDA=DA

 D ^DIE

 L -@(DIE_APCLDIDA_")"):0

 I $D(DTOUT)!$D(DUOUT) S (APCLLTQT,APCLLTOT)=""

 K DIE,DA,DR,APCLDIDA

 Q

DDS ;EP;FOR SCREENMAN CALLS

 S DDSFILE=DIE

 D ^DDS

 K DDSFILE,APCLCREN

 Q

FILE ;EP;

 K DD,DO,DTOUT,DUOUT,APCLLTQT,APCLLTOT

 D FILE^DICN

 S:$D(DTOUT)!$D(DUOUT)!(X="^^") (APCLLTQT,APCLLTOT)=""

 K DIC,DA,DD,DR,DINUM,DLAYGO

 Q

DIR ;EP;

 I $D(APCLLTOT) K DIR S Y="" Q

 K DTOUT,DUOUT,APCLLTQT,APCLLTOT

 D ^DIR

 S APCLLTY=Y

 S:$D(DIRUT)!$D(DIROUT)!$D(DUOUT) APCLLTQT=""

 S:X="^^"!$D(DTOUT) (APCLLTQT,APCLLTOT)=""

 K DIR,DIRUT,DIROUT,DUOUT,DTOUT

 Q

DIK ;EP;

 K DTOUT,DUOUT,APCLLTQT,APCLLTOT

 D ^DIK

 K DIK

 Q

IX1 ;EP;

 Q:$D(APCLLTOT)

 K DTOUT,DUOUT,APCLLTQT,APCLLTOT

 D IX1^DIK

 K DIK,DA

 Q

DIQ1 ;EP;

 D EN^DIQ1

 K DIC,DA,DR,DIQ

 Q

WP ;EP;TO BROWSE WORD PROCESSING FIELD

 Q:'$D(APCLFILE)#2!'$D(APCLIEN)#2!'$D(APCLFIEL)

 K ACMSCREN

 D WP^DDBR(APCLFILE,APCLIEN,APCLFIEL,"N",$G(APCLTITL))

 Q

APCLLTD   ; IHS/CMI/LAB - FILEMAN INTERFACE UTILITY ;

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

 +2       ;;UTILITY ROUTINE USED TO MANAGE ALL INTERFACE TO FILEMAN

 +3       ;;WITH FEW EXCEPTIONS, THIS IS THE ONLY PLACE IN ARMS FROM WHICH

 +4       ;;FILEMAN ENTRY POINTS ARE CALLED

DIC       ;EP;

 +1        IF $DATA(APCLLTOT)

               QUIT 

 +2        KILL DTOUT,DUOUT,APCLLTQT,APCLLTOT

 +3        DO ^DIC

 +4        IF $DATA(DUOUT)

               SET APCLLTQT=""

 +5        IF $DATA(DTOUT)!(X="^^")

               SET (APCLLTQT,APCLLTOT)=""

 +6       ;IHS/CMI/THL PATCH 4 ADD 'DIADD' TO KILL LIST

           KILL DIC,DA,DD,DR,DINUM,D,DLAYGO,DIADD

 +7        QUIT 

MIX       ;EP;

 +1        IF $DATA(APCLLTOT)

               QUIT 

 +2        KILL DTOUT,DUOUT,APCLLTQT,APCLLTOT

 +3        DO MIX^DIC1

 +4        IF $DATA(DTOUT)!$DATA(DUOUT)!(X="^^")

               SET (APCLLTQT,APCLLTOT)=""

 +5        KILL DIC,DA,DD,DR,DINUM,D,DLAYGO

 +6        QUIT 

IX        ;EP;

 +1        IF $DATA(APCLLTOT)

               QUIT 

 +2        KILL DTOUT,DUOUT,APCLLTQT,APCLLTOT

 +3        DO IX^DIC

 +4        IF $DATA(DTOUT)!$DATA(DUOUT)!(X="^^")

               SET (APCLLTQT,APCLLTOT)=""

 +5        KILL DIC,DA,DD,DR,DINUM,D,DLAYGO

 +6        QUIT 

DIE       ;EP;

 +1        IF $DATA(APCLLTOT)

               QUIT 

 +2        IF 'DA

               QUIT 

 +3        KILL DTOUT,DUOUT,APCLLTQT,APCLLTOT

 +4        LOCK +@(DIE_DA_")"):4

           IF '$TEST

               SET APCLLTQT=""

               IF '$DATA(IOST)#2

                   QUIT 

               IF $EXTRACT(IOST,1,2)="C-"

                   WRITE !!,"Entry being edited by another user.  Please try Later.",!

               HANG 3

               QUIT 

 +5        SET APCLDIDA=DA

 +6        DO ^DIE

 +7        LOCK -@(DIE_APCLDIDA_")"):0

 +8        IF $DATA(DTOUT)!$DATA(DUOUT)

               SET (APCLLTQT,APCLLTOT)=""

 +9        KILL DIE,DA,DR,APCLDIDA

 +10       QUIT 

DDS       ;EP;FOR SCREENMAN CALLS

 +1        SET DDSFILE=DIE

 +2        DO ^DDS

 +3        KILL DDSFILE,APCLCREN

 +4        QUIT 

FILE      ;EP;

 +1        KILL DD,DO,DTOUT,DUOUT,APCLLTQT,APCLLTOT

 +2        DO FILE^DICN

 +3        IF $DATA(DTOUT)!$DATA(DUOUT)!(X="^^")

               SET (APCLLTQT,APCLLTOT)=""

 +4        KILL DIC,DA,DD,DR,DINUM,DLAYGO

 +5        QUIT 

DIR       ;EP;

 +1        IF $DATA(APCLLTOT)

               KILL DIR

               SET Y=""

               QUIT 

 +2        KILL DTOUT,DUOUT,APCLLTQT,APCLLTOT

 +3        DO ^DIR

 +4        SET APCLLTY=Y

 +5        IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DUOUT)

               SET APCLLTQT=""

 +6        IF X="^^"!$DATA(DTOUT)

               SET (APCLLTQT,APCLLTOT)=""

 +7        KILL DIR,DIRUT,DIROUT,DUOUT,DTOUT

 +8        QUIT 

DIK       ;EP;

 +1        KILL DTOUT,DUOUT,APCLLTQT,APCLLTOT

 +2        DO ^DIK

 +3        KILL DIK

 +4        QUIT 

IX1       ;EP;

 +1        IF $DATA(APCLLTOT)

               QUIT 

 +2        KILL DTOUT,DUOUT,APCLLTQT,APCLLTOT

 +3        DO IX1^DIK

 +4        KILL DIK,DA

 +5        QUIT 

DIQ1      ;EP;

 +1        DO EN^DIQ1

 +2        KILL DIC,DA,DR,DIQ

 +3        QUIT 

WP        ;EP;TO BROWSE WORD PROCESSING FIELD

 +1        IF '$DATA(APCLFILE)#2!'$DATA(APCLIEN)#2!'$DATA(APCLFIEL)

               QUIT 

 +2        KILL ACMSCREN

 +3        DO WP^DDBR(APCLFILE,APCLIEN,APCLFIEL,"N",$GET(APCLTITL))

 +4        QUIT