BMCFDRP.m

BMCFDRP ; IHS/OIT/FCJ - DRIVER TO PRINT PHY CONSULT LETTER ;        [ 09/27/2006  2:44 PM ]

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006;Build 101

 ;IHS/ITSC/FCJ ADD LINE TO TEST FOR CLOSING SLAVE DEVICE

START ;

 W:$D(IOF) @IOF

 W "**********  REFERRAL PHYSICIAN CONSULT LETTER  **********",!!

 W "This report will produce a hard copy computer generated Consult letter.",!

GETREF ;get referral entry

 D GETTYPE

 W !! S BMCREF=""

 S DIC="^BMCREF(",DIC(0)="AEMQ",DIC("A")="Select Referral by Patient Name, date of referral or referral #: "

 S DIC("S")="I $$FILTER^BMCFLTR(3,0,2)"

 D ^DIC K DA,DIC

 G:Y=-1 XIT

 S BMCREF=+Y

 I $D(^BMCTFORM(BMCFTYPE,11)) X ^BMCTFORM(BMCFTYPE,11) G:BMCQUIT GETREF

 ;

ZIS ;

 W !! S XBRC="COMP^BMCFDRP",XBRP="PRINT^BMCFDRP",XBNS="BMC",XBRX="XIT^BMCFDRP"

 D ^XBDBQUE

 Q

 ;

GETTYPE ;

 S BMCQUIT=0

 S BMCFTYPE=""

 S BMCFTYPE=$O(^BMCTFORM("B","STANDARD CONSULT LETTER",BMCFTYPE))

 Q

PRINT ;EP

 N BMCFTYPE

 D GETTYPE

 X:$D(^BMCTFORM(BMCFTYPE,12)) ^BMCTFORM(BMCFTYPE,12)

 N BMCFTYPE

XIT ;

 K BMCCAP,BMCCHSR,BMCDA,BMCFILE,BMCFTYPE,BMCIOM,BMCKPDA,BMCNODE,BMCPG,BMCQUIT,BMCR0,BMCREF,BMCRNS,BMCV,BMCWP,BMCX,BMCY,BMCI,BMCDFN,BMCCHSAS

 K A,C,D,D0,D1,DA,DD,DDSFILE,DI,DIADD,DIC,DICR,DIE,DIK,DINUM,DIPGM,DIQ,DIR,DIW,DIWI,DIWT,DIWTC,DIWX,DIWF,DIWL,DIWR,DLAYGO,DO,DQ,DR,DTOUT

 K F,G,I,J,N,P,T,X,Y,Z

 K BMCPROUT,BMCN,BMCNI,BMCNUM,BMCVIEN

 K BMCCHSCT,BMCCMT,BMCRDATE,BMCREC,BMCRIEN,BMCRIO,BMCRNUMB,BMCRSTAT,BMCRTYPE,BMCVST,BMCVSTP

 I $D(IO("S")) S IOP="`"_IOS D ^%ZIS

 Q

COMP ;

 Q

BMCFDRP   ; IHS/OIT/FCJ - DRIVER TO PRINT PHY CONSULT LETTER ;        [ 09/27/2006  2:44 PM ]

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006;Build 101

 +2       ;IHS/ITSC/FCJ ADD LINE TO TEST FOR CLOSING SLAVE DEVICE

START     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE "**********  REFERRAL PHYSICIAN CONSULT LETTER  **********",!!

 +3        WRITE "This report will produce a hard copy computer generated Consult letter.",!

GETREF    ;get referral entry

 +1        DO GETTYPE

 +2        WRITE !!

           SET BMCREF=""

 +3        SET DIC="^BMCREF("

           SET DIC(0)="AEMQ"

           SET DIC("A")="Select Referral by Patient Name, date of referral or referral #: "

 +4        SET DIC("S")="I $$FILTER^BMCFLTR(3,0,2)"

 +5        DO ^DIC

           KILL DA,DIC

 +6        IF Y=-1

               GOTO XIT

 +7        SET BMCREF=+Y

 +8        IF $DATA(^BMCTFORM(BMCFTYPE,11))

               XECUTE ^BMCTFORM(BMCFTYPE,11)

               IF BMCQUIT

                   GOTO GETREF

 +9       ;

ZIS       ;

 +1        WRITE !!

           SET XBRC="COMP^BMCFDRP"

           SET XBRP="PRINT^BMCFDRP"

           SET XBNS="BMC"

           SET XBRX="XIT^BMCFDRP"

 +2        DO ^XBDBQUE

 +3        QUIT 

 +4       ;

GETTYPE   ;

 +1        SET BMCQUIT=0

 +2        SET BMCFTYPE=""

 +3        SET BMCFTYPE=$ORDER(^BMCTFORM("B","STANDARD CONSULT LETTER",BMCFTYPE))

 +4        QUIT 

PRINT     ;EP

 +1        NEW BMCFTYPE

 +2        DO GETTYPE

 +3        IF $DATA(^BMCTFORM(BMCFTYPE,12))

               XECUTE ^BMCTFORM(BMCFTYPE,12)

 +4        NEW BMCFTYPE

XIT       ;

 +1        KILL BMCCAP,BMCCHSR,BMCDA,BMCFILE,BMCFTYPE,BMCIOM,BMCKPDA,BMCNODE,BMCPG,BMCQUIT,BMCR0,BMCREF,BMCRNS,BMCV,BMCWP,BMCX,BMCY,BMCI,BMCDFN,BMCCHSAS

 +2        KILL A,C,D,D0,D1,DA,DD,DDSFILE,DI,DIADD,DIC,DICR,DIE,DIK,DINUM,DIPGM,DIQ,DIR,DIW,DIWI,DIWT,DIWTC,DIWX,DIWF,DIWL,DIWR,DLAYGO,DO,DQ,DR,DTOUT

 +3        KILL F,G,I,J,N,P,T,X,Y,Z

 +4        KILL BMCPROUT,BMCN,BMCNI,BMCNUM,BMCVIEN

 +5        KILL BMCCHSCT,BMCCMT,BMCRDATE,BMCREC,BMCRIEN,BMCRIO,BMCRNUMB,BMCRSTAT,BMCRTYPE,BMCVST,BMCVSTP

 +6        IF $DATA(IO("S"))

               SET IOP="`"_IOS

               DO ^%ZIS

 +7        QUIT 

COMP      ;

 +1        QUIT