BWFMAN.m

BWFMAN ;IHS/ANMC/MWR - FILEMAN CALLS;15-Feb-2003 22:35;PLS

 ;;2.0;WOMEN'S HEALTH;**8,13**;APR 19, 1996;Build 9

 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 ;;  CALLS TO FILEMAN WITH PRE- AND POST-CALL VARIABLE SETTING.

 ;

 ;

DIC(DIC,DIC0,Y,DICA,DICB,DICS,X,BWPOP) ;EP

 ;---> CALL TO ^DIC

 ;---> PARAMETERS:

 ;     1 - DIC=DIC       (REQUIRED)

 ;     2 - DIC0=DIC(0)   (REQUIRED)

 ;     3 - Y             (RETURNED) FROM CALL TO ^DIC

 ;     4 - DICA=DIC("A") (OPTIONAL) PROMPT

 ;     5 - DICB=DIC("B") (OPTIONAL) DEFAULT

 ;     6 - DICS=DIC("S") (OPTIONAL) SCREEN

 ;     7 - X             (OPTIONAL) IF DIC(0)'["A"

 ;     8 - BWPOP         (OPTIONAL) BWPOP=1 IF DTOUT OR DUOUT

 ;

 ;---> EXAMPLE: D DIC^BWFMAN(9002086,"QEMAL",.Y,"   Select PATIENT: ")

 ;

 I $G(DIC)']""!($G(DIC0)']"") S BWPOP=1 Q

 S BWPOP=0 S:DIC DLAYGO=$P(DIC,".")

 S DIC(0)=DIC0

 S:$G(DICA)]"" DIC("A")=DICA

 S:$G(DICB)]"" DIC("B")=DICB

 S:$G(DICS)]"" DIC("S")=DICS

 D ^DIC

 S:($D(DTOUT))!($D(DUOUT)) BWPOP=1

 D DKILLS

 Q

 ;

DDS(DDSFILE,DR,DA,DDSPARM,DDSCHANG,BWPOP) ;EP

 ;---> CALL TO ^DDS

 ;---> NOTE: SCREENMAN AUTOMATICALLY USES INCREMENTAL LOCKS.

 ;---> PARAMETERS:

 ;     1 - DDSFILE=FILE# (REQUIRED)

 ;     2 - DR=FORM       (REQUIRED)

 ;     3 - DA=RECORD     (REQUIRED)

 ;     4 - DDSPARM (C/E) (OPTIONAL) C=REGISTER CHANGE IN DDSCHANG

 ;     5 - DDSCHANG      (RETURNED) DDSCHANG=1 IF CHANGE TO DATABASE

 ;     6 - BWPOP         (RETURNED) FAIL/QUIT/TIMEOUT

 ;

 ;---> EXAMPLES:

 ;     D DDS^BWFMAN(9002086.02,"[BW SITE PARAMS-FORM-1]",+Y)

 ;     D DDS^BWFMAN(9002086.1,"[BW PROC-FORM-LAB]",DA,"C",.BWCHG,.BWPOP)

 ;

 N BWDA S BWDA=DA,BWPOP=0

 I DDSFILE S DDSFILE=^DIC(DDSFILE,0,"GL")

 L +@(DDSFILE_BWDA_")"):5 I '$T S BWPOP=1 D LOCKED^BWUTL3 Q

 K ^TMP("DDS",$J)

 D:'$D(IOST(0)) HOME^%ZIS D ENS^%ZISS

 D ^DDS

 S:$D(DTOUT) BWPOP=1

 I $D(DIMSG)!($D(DIERR)) D  S BWPOP=1

 .W !?5,"* The Screen Manager could not edit this record."

 .W !?7,"Please contact your Site Manager." D DIRZ^BWUTL3

 L -@(DDSFILE_BWDA_")")

 D DKILLS

 Q

 ;

DIE(DIE,DR,DA,BWPOP,Z) ;EP

 ;---> CALL TO ^DIE

 ;---> PARAMETERS:

 ;     1 - DIE=DIE (REQUIRED)

 ;     2 - DR=DR   (REQUIRED)

 ;     3 - DA=DA   (REQUIRED)

 ;     4 - BWPOP   (RETURNED) BWPOP=1 INDICATES FAILURE/QUIT

 ;     5 - Z       (OPTIONAL) Z=1 IF USER SHOULD *NOT* BE NOTIFIED

 ;                            RECORD WAS LOCKED.

 ;

 ;---> EXAMPLE: D DIE^BWFMAN(9002086,DR,+Y,.BWPOP)

 ;              (+Y FROM DIC CALL, DR COULD BE LITERAL IF SHORT.)

 ;

 N BWDA S BWDA=DA,BWPOP=0

 I DIE S DIE=^DIC(DIE,0,"GL")

 L +@(DIE_BWDA_")"):5 I '$T S BWPOP=1 D:'$G(Z) LOCKED^BWUTL3 Q

 D ^DIE

 I $D(DTOUT) S BWPOP=1

 L -@(DIE_BWDA_")")

 D DKILLS

 Q

 ;

FILE(DIC,DICDR,DIC0,X,DLAYGO,Y) ; EP - CALL FILE^DICN

 K DD,DO

 I DIC S DIC=^DIC(DIC,0,"GL")

 S:$G(DICDR)]"" DIC("DR")=DICDR S DIC(0)=DIC0

 D FILE^DICN

 D DKILLS

 Q

 ;

DIK ; EP - CALL ^DIK

 D ^DIK

 D DKILLS

 Q

 ;

DIQ ; EP - CALL ^DIQ

 D EN^DIQ

 D DKILLS

 Q

 ;

DIQ1 ; EP - CALL ^DIQ1

 D EN^DIQ1

 D DKILLS

 Q

 ;

DKILLS ;EP

 K D,D0,D1,DA,DD,DDH,DI,DIADD,DIC,DIC1,DICR,DIE,DIG,DIH,DIK,DILC

 K DINUM,DIRUT,DIQ,DIQ2,DIR,DIU,DIW,DIWF,DIWL,DIWR,DIWT,DK,DL

 K DLAYGO,DN,DQ,DR,DTOUT,DUOUT,DX

 Q

 ;

SCRN(BN) ;EP

 NEW CMN,TN,TAX,REF,BWTAX

 S CMN=$O(^BTPW(90621,"AP",BN,"")) I CMN="" Q 0

 S TN=0 F  S TN=$O(^BTPW(90621,CMN,1,TN)) Q:'TN  D

 . I $P(^BTPW(90621,CMN,1,TN,0),U,3)'=5 Q

 . S TAX=$P(^BTPW(90621,CMN,1,TN,0),U,1),REF="BWTAX" K @REF

 . D BLD^BQITUTL(TAX,.REF)

 I $P(^ICPT(Y,0),U,4) Q 0

 I '$D(BWTAX(Y)) Q 0

 Q 1

BWFMAN    ;IHS/ANMC/MWR - FILEMAN CALLS;15-Feb-2003 22:35;PLS

 +1       ;;2.0;WOMEN'S HEALTH;**8,13**;APR 19, 1996;Build 9

 +2       ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 +3       ;;  CALLS TO FILEMAN WITH PRE- AND POST-CALL VARIABLE SETTING.

 +4       ;

 +5       ;

DIC(DIC,DIC0,Y,DICA,DICB,DICS,X,BWPOP) ;EP

 +1       ;---> CALL TO ^DIC

 +2       ;---> PARAMETERS:

 +3       ;     1 - DIC=DIC       (REQUIRED)

 +4       ;     2 - DIC0=DIC(0)   (REQUIRED)

 +5       ;     3 - Y             (RETURNED) FROM CALL TO ^DIC

 +6       ;     4 - DICA=DIC("A") (OPTIONAL) PROMPT

 +7       ;     5 - DICB=DIC("B") (OPTIONAL) DEFAULT

 +8       ;     6 - DICS=DIC("S") (OPTIONAL) SCREEN

 +9       ;     7 - X             (OPTIONAL) IF DIC(0)'["A"

 +10      ;     8 - BWPOP         (OPTIONAL) BWPOP=1 IF DTOUT OR DUOUT

 +11      ;

 +12      ;---> EXAMPLE: D DIC^BWFMAN(9002086,"QEMAL",.Y,"   Select PATIENT: ")

 +13      ;

 +14       IF $GET(DIC)']""!($GET(DIC0)']"")

               SET BWPOP=1

               QUIT 

 +15       SET BWPOP=0

           IF DIC

               SET DLAYGO=$PIECE(DIC,".")

 +16       SET DIC(0)=DIC0

 +17       IF $GET(DICA)]""

               SET DIC("A")=DICA

 +18       IF $GET(DICB)]""

               SET DIC("B")=DICB

 +19       IF $GET(DICS)]""

               SET DIC("S")=DICS

 +20       DO ^DIC

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

               SET BWPOP=1

 +22       DO DKILLS

 +23       QUIT 

 +24      ;

DDS(DDSFILE,DR,DA,DDSPARM,DDSCHANG,BWPOP) ;EP

 +1       ;---> CALL TO ^DDS

 +2       ;---> NOTE: SCREENMAN AUTOMATICALLY USES INCREMENTAL LOCKS.

 +3       ;---> PARAMETERS:

 +4       ;     1 - DDSFILE=FILE# (REQUIRED)

 +5       ;     2 - DR=FORM       (REQUIRED)

 +6       ;     3 - DA=RECORD     (REQUIRED)

 +7       ;     4 - DDSPARM (C/E) (OPTIONAL) C=REGISTER CHANGE IN DDSCHANG

 +8       ;     5 - DDSCHANG      (RETURNED) DDSCHANG=1 IF CHANGE TO DATABASE

 +9       ;     6 - BWPOP         (RETURNED) FAIL/QUIT/TIMEOUT

 +10      ;

 +11      ;---> EXAMPLES:

 +12      ;     D DDS^BWFMAN(9002086.02,"[BW SITE PARAMS-FORM-1]",+Y)

 +13      ;     D DDS^BWFMAN(9002086.1,"[BW PROC-FORM-LAB]",DA,"C",.BWCHG,.BWPOP)

 +14      ;

 +15       NEW BWDA

           SET BWDA=DA

           SET BWPOP=0

 +16       IF DDSFILE

               SET DDSFILE=^DIC(DDSFILE,0,"GL")

 +17       LOCK +@(DDSFILE_BWDA_")"):5

           IF '$TEST

               SET BWPOP=1

               DO LOCKED^BWUTL3

               QUIT 

 +18       KILL ^TMP("DDS",$JOB)

 +19       IF '$DATA(IOST(0))

               DO HOME^%ZIS

           DO ENS^%ZISS

 +20       DO ^DDS

 +21       IF $DATA(DTOUT)

               SET BWPOP=1

 +22       IF $DATA(DIMSG)!($DATA(DIERR))

               Begin DoDot:1

 +23               WRITE !?5,"* The Screen Manager could not edit this record."

 +24               WRITE !?7,"Please contact your Site Manager."

                   DO DIRZ^BWUTL3

               End DoDot:1

               SET BWPOP=1

 +25       LOCK -@(DDSFILE_BWDA_")")

 +26       DO DKILLS

 +27       QUIT 

 +28      ;

DIE(DIE,DR,DA,BWPOP,Z) ;EP

 +1       ;---> CALL TO ^DIE

 +2       ;---> PARAMETERS:

 +3       ;     1 - DIE=DIE (REQUIRED)

 +4       ;     2 - DR=DR   (REQUIRED)

 +5       ;     3 - DA=DA   (REQUIRED)

 +6       ;     4 - BWPOP   (RETURNED) BWPOP=1 INDICATES FAILURE/QUIT

 +7       ;     5 - Z       (OPTIONAL) Z=1 IF USER SHOULD *NOT* BE NOTIFIED

 +8       ;                            RECORD WAS LOCKED.

 +9       ;

 +10      ;---> EXAMPLE: D DIE^BWFMAN(9002086,DR,+Y,.BWPOP)

 +11      ;              (+Y FROM DIC CALL, DR COULD BE LITERAL IF SHORT.)

 +12      ;

 +13       NEW BWDA

           SET BWDA=DA

           SET BWPOP=0

 +14       IF DIE

               SET DIE=^DIC(DIE,0,"GL")

 +15       LOCK +@(DIE_BWDA_")"):5

           IF '$TEST

               SET BWPOP=1

               IF '$GET(Z)

                   DO LOCKED^BWUTL3

               QUIT 

 +16       DO ^DIE

 +17       IF $DATA(DTOUT)

               SET BWPOP=1

 +18       LOCK -@(DIE_BWDA_")")

 +19       DO DKILLS

 +20       QUIT 

 +21      ;

FILE(DIC,DICDR,DIC0,X,DLAYGO,Y) ; EP - CALL FILE^DICN

 +1        KILL DD,DO

 +2        IF DIC

               SET DIC=^DIC(DIC,0,"GL")

 +3        IF $GET(DICDR)]""

               SET DIC("DR")=DICDR

           SET DIC(0)=DIC0

 +4        DO FILE^DICN

 +5        DO DKILLS

 +6        QUIT 

 +7       ;

DIK       ; EP - CALL ^DIK

 +1        DO ^DIK

 +2        DO DKILLS

 +3        QUIT 

 +4       ;

DIQ       ; EP - CALL ^DIQ

 +1        DO EN^DIQ

 +2        DO DKILLS

 +3        QUIT 

 +4       ;

DIQ1      ; EP - CALL ^DIQ1

 +1        DO EN^DIQ1

 +2        DO DKILLS

 +3        QUIT 

 +4       ;

DKILLS    ;EP

 +1        KILL D,D0,D1,DA,DD,DDH,DI,DIADD,DIC,DIC1,DICR,DIE,DIG,DIH,DIK,DILC

 +2        KILL DINUM,DIRUT,DIQ,DIQ2,DIR,DIU,DIW,DIWF,DIWL,DIWR,DIWT,DK,DL

 +3        KILL DLAYGO,DN,DQ,DR,DTOUT,DUOUT,DX

 +4        QUIT 

 +5       ;

SCRN(BN)  ;EP

 +1        NEW CMN,TN,TAX,REF,BWTAX

 +2        SET CMN=$ORDER(^BTPW(90621,"AP",BN,""))

           IF CMN=""

               QUIT 0

 +3        SET TN=0

           FOR 

               SET TN=$ORDER(^BTPW(90621,CMN,1,TN))

               IF 'TN

                   QUIT 

               Begin DoDot:1

 +4                IF $PIECE(^BTPW(90621,CMN,1,TN,0),U,3)'=5

                       QUIT 

 +5                SET TAX=$PIECE(^BTPW(90621,CMN,1,TN,0),U,1)

                   SET REF="BWTAX"

                   KILL @REF

 +6                DO BLD^BQITUTL(TAX,.REF)

               End DoDot:1

 +7        IF $PIECE(^ICPT(Y,0),U,4)

               QUIT 0

 +8        IF '$DATA(BWTAX(Y))

               QUIT 0

 +9        QUIT 1