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
