BNIG ; IHS/CMI/LAB - group entry for bni ;
;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
;; ;
START ; Write Header
D EOJ ; -- kill all vars before starting
W:$D(IOF) @IOF
F J=1:1:13 S X=$P($T(TEXT+J),";;",2) W !?80-$L(X)\2,X
K X,J
START1 ;
I '$O(^BNISITE(0)) W !!,"Site parameters have not been set up. Please see the system manager." D PAUSE,EOJ Q
W !!
D GETSITE
I BNISITE="" D EOJ Q
D ADDQ
I BNIADDQ="" G START1
AGR ;
D FULL^VALM1
W !!
MNTH ;
S (BNIMNTH,BNIDATE,BNIYR)="" ;,DIR(0)="DO^:"_DT_":EPTX",DIR("A")="Enter Date of Activity" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
S DIR(0)="S^1:JANUARY;2:FEBRUARY;3:MARCH;4:APRIL;5:MAY;6:JUNE;7:JULY;8:AUGUST;9:SEPTEMBER;10:OCTOBER;11:NOVEMBER;12:DECEMBER",DIR("A")="Enter the MONTH the activity took place" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D PAUSE G EOJ
S BNIMNTH=Y I $L(BNIMNTH)=1 S BNIMNTH="0"_BNIMNTH
YR ;
S BNIYR=""
S (BNIPER,BNIVDT)=""
K DIR S DIR(0)="D^::EP",DIR("B")=$$FMTE^XLFDT(($E(DT,1,3)_"0000"))
S DIR("A")="Enter Year"
S DIR("?")="Enter the year the activity took place. E.g. 2006 or 06"
D ^DIR KILL DIR
I $D(DIRUT) D PAUSE G MNTH
I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G YR
S BNIYR=Y
S BNIDATE=BNIYR,$E(BNIDATE,4,5)=BNIMNTH
I BNIDATE>DT W !!,"Future dates are not allowed!",! G MNTH
;
ADDR ;
K DIC S DIC(0)="EL",DIC="^BNIGROUP(",DLAYGO=90510.5,DIADD=1,X=BNIDATE
S DIC("DR")=".02////"_DT_";.03////"_DUZ_";.06////"_DUZ(2)_";.07////"_DUZ(2)
K DD,DO,D0 D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
I Y=-1 W !!,$C(7),$C(7),"CPHAD Group Record is NOT complete!! Deleting Record.",! D PAUSE,EOJ Q
;update multiple of user last update/date edited
S BNIGR=+Y
ADDR1 ;
S DA=BNIGR,DDSFILE=90510.5,DR=$S($G(BNIADDQ):"[BNIA GROUP ENTRY]",1:"[BNI GROUP ENTRY]") D ^DDS
I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***" D PAUSE,EOJ Q
;check record for completeness
D CHECKREC
I Q D G:BNIA="E" ADDR1 D DELR,PAUSE,EOJ Q
.S BNIA="" K DIR
.S DIR(0)="S^E:Edit and complete the Group Record;D:Delete the Incomplete Group Record",DIR("A")="Do you wish to",DIR("B")="E" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) S BNIA="D"
.S BNIA=Y
GROUP ;
W !!,"I will now create an individual activity record for the following:"
S X=0 F S X=$O(^BNIGROUP(BNIGR,16,X)) Q:X'=+X W !?5,$P(^VA(200,$P(^BNIGROUP(BNIGR,16,X,0),U),0),U)
S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !!,"No records created." D PAUSE,EOJ Q
S BNIX=0 F S BNIX=$O(^BNIGROUP(BNIGR,16,BNIX)) Q:BNIX'=+BNIX D
.S BNIPRV=$P(^BNIGROUP(BNIGR,16,BNIX,0),U)
.W !,"Creating record for ",$P(^VA(200,BNIPRV,0),U)
.K DIC S DIC(0)="EL",DIC="^BNIREC(",DLAYGO=90510,DIADD=1,X=BNIDATE
.S DIC("DR")=".02////"_DT_";.03////"_DUZ_";.06////"_DUZ(2)_";.08////"_BNIPRV
.K DD,DO,D0 D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
.I Y=-1 W !!,$C(7),$C(7),"Creating record for ",$P(^VA(200,BNIPRV,0),U)," failed!! Deleting Record.",! D PAUSE,EOJ Q
.;update multiple of user last update/date edited
.S BNIR=+Y
.S DIE="^BNIREC(",DA=BNIR,DR="1500///NOW",DR(2,90510.0115)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR
.F BNIZ=7,9,11:1:18 S $P(^BNIREC(BNIR,0),U,BNIZ)=$P(^BNIGROUP(BNIGR,0),U,BNIZ)
.F BNIZ=1,2 I $P($G(^BNIGROUP(BNIGR,11)),U,BNIZ)]"" S $P(^BNIREC(BNIR,11),U,BNIZ)=$P(^BNIGROUP(BNIGR,0),U,BNIZ)
.F BNIZ=1 I $P($G(^BNIGROUP(BNIGR,12)),U,BNIZ)]"" S $P(^BNIREC(BNIR,12),U,BNIZ)=$P(^BNIGROUP(BNIGR,12),U,BNIZ)
.S BNIW=0 F S BNIW=$O(^BNIGROUP(BNIGR,14,BNIW)) Q:BNIW'=+BNIW D
..S ^BNIREC(BNIR,14,BNIW,0)=^BNIGROUP(BNIGR,14,BNIW,0)
..S ^BNIREC(BNIR,14,0)="^^"_BNIW_"^"_BNIW_"^"_DT_"^"
.S DA=BNIR,DIK="^BNIREC(" D IX1^DIK
W !,"Records created."
D PAUSE
D EOJ
Q
;
EOJ ;EOJ CLEANUP
D CLEAR^VALM1
D EN^XBVK("BNI")
Q
GETSITE ;
S BNISITE=""
W ! K DIC S DIC="^BNISITE(",DIC("A")="Enter your Site: ",DIC("B")=$P(^DIC(4,DUZ(2),0),U),DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1 Q
S BNISITE=+Y
Q
ADDQ ;
S BNIADDQ=""
W !
K DIR
S DIR(0)="Y",DIR("A")="Do you want to be prompted for Travel Time and Number Served",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
S BNIADDQ=Y
Q
DATE(D) ;
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
;
;
TEXT ;
;;Computerized Public Health Activity (CPHAD) Group Data Entry
;;
;;***************************************
;;* Update CPHAD Group Activity Records *
;;***************************************
;;
;;This option is used to enter a GROUP Activity Record.
;;You will be asked to enter all information about the activity
;;including all persons who participated in the activity.
;;When all information is entered a public health activity record
;;will be generated for each person who participated in the
;;group activity.
;;
Q
SHT(G) ;EP - called from screenman screen
I $G(G)="" Q ""
NEW X
S X=$O(^BNISHT("AA",G,1,0))
I X,$D(^BNISHT(X,0)) Q $P(^BNISHT(X,0),U,1)
Q ""
GHCPOST ;EP - called from screenman
D REQ^DDSUTL(4,2,1,$S('$G(X):0,$P(^BNIGHC(X,0),U,3)=1:1,1:0)) ;require other if Other
I 'X D PUT^DDSVAL(DIE,.DA,1101,"") ;empty out 1101 if not Other
I X,'$P(^BNIGHC(X,0),U,3) D PUT^DDSVAL(DIE,.DA,1101,"")
D UNED^DDSUTL(4,2,1,$S('$G(X):1,$P(^BNIGHC(X,0),U,3)=1:0,1:1)) ;don't allow field 7 if not other
S BNISMGNC=X
NEW Z
S Z=$$GET^DDSVAL(DIE,.DA,.12)
I Z="" D PUT^DDSVAL(DIE,.DA,.12,$$SHT(BNISMGNC))
I Z]"" D
.Q:$P(^BNISHT(Z,0),U,3)=BNISMGNC
.D PUT^DDSVAL(DIE,.DA,.12,$$SHT(BNISMGNC))
.Q
D REFRESH^DDSUTL
Q
SHTPOST ;EP - called from screenman
D REQ^DDSUTL(6,2,1,$S('$G(X):0,$P(^BNISHT(X,0),U,5)=1:1,1:0)) ;require other if Other
I 'X D PUT^DDSVAL(DIE,.DA,1102,"") ;empty out 1101 if not Other
I X,'$P(^BNISHT(X,0),U,5) D PUT^DDSVAL(DIE,.DA,1102,"")
D UNED^DDSUTL(6,2,1,$S('$G(X):1,$P(^BNISHT(X,0),U,5)=1:0,1:1)) ;don't allow field 8 if not other
D REFRESH^DDSUTL
Q
TOAPOST ;EP - called from screenman
D REQ^DDSUTL(8,2,1,$S('$G(X):0,$P(^BNITOA(X,0),U,3)=1:1,1:0)) ;require other if Other
I 'X D PUT^DDSVAL(DIE,.DA,1103,"") ;empty out 1101 if not Other
I X,'$P(^BNITOA(X,0),U,3) D PUT^DDSVAL(DIE,.DA,1103,"")
D UNED^DDSUTL(8,2,1,$S('$G(X):1,$P(^BNITOA(X,0),U,3)=1:0,1:1)) ;don't allow field 8 if not other
D REFRESH^DDSUTL
Q
GSPOST ;EP - called from screenman
D REQ^DDSUTL(10,2,1,$S('$G(X):0,$P(^BNIGS(X,0),U,3)=1:1,1:0)) ;require other if Other
I 'X D PUT^DDSVAL(DIE,.DA,1104,"") ;empty out 1101 if not Other
I X,'$P(^BNIGS(X,0),U,3) D PUT^DDSVAL(DIE,.DA,1104,"")
D UNED^DDSUTL(10,2,1,$S('$G(X):1,$P(^BNIGS(X,0),U,3)=1:0,1:1)) ;don't allow field 10 if not other
D REFRESH^DDSUTL
Q
ASPOST ;EP - called from screenman
D REQ^DDSUTL(12,2,1,$S('$G(X):0,$P(^BNIAS(X,0),U,3)=1:1,1:0)) ;require other if Other
I 'X D PUT^DDSVAL(DIE,.DA,.16,"") ;empty out 1101 if not Other
I X,'$P(^BNIAS(X,0),U,3) D PUT^DDSVAL(DIE,.DA,.16,"")
D UNED^DDSUTL(12,2,1,$S('$G(X):1,$P(^BNIAS(X,0),U,3)=1:0,1:1)) ;don't allow field 12 if not other
D REFRESH^DDSUTL
Q
SHTSCR(I) ;EP - called from screen on dd 90510 FIELD .12
I '$G(BNISMGNC) Q 1
I $P(^BNISHT(I,0),U,3)'=BNISMGNC Q 0
Q 1
COMM(I) ;EP - called from screen on dd 90510 field .16
I '$G(BNISITE) Q 1
NEW Z,C
S Z=$P($G(^BNISITE(BNISITE,0)),U,3)
I 'Z Q 1
S C=$P(^AUTTCOM(Y,0),U)
I '$D(^ATXAX(Z,0)) Q 1
I '$D(^ATXAX(Z,21,"B",C)) Q 0
Q 1
CHECKREC ;
S Q="" F F=.07,.09,.11,.12,.13 I $P(^BNIGROUP(BNIGR,0),U,+$P(F,".",2))="" D
.W !,$P(^DD(90510,F,0),U)," is a required field and is missing." S Q=1
I $P($G(^BNISITE(BNISITE,0)),U,2),$P(^BNIGROUP(BNIGR,0),U,15)="" D
.W !,"ACTIVITY SETTING is required and is missing." S Q=1
S X=$P(^BNIGROUP(BNIGR,0),U,11) I X,$P(^BNIGHC(X,0),U,3),$P($G(^BNIGROUP(BNIGR,11)),U,1)="" D
.W !,"GENERAL HEALTH CONCERN is ",$P(^BNIGHC(X,0),U),!," and the text of GENERAL HEALTH CONCERN (OTHER) is missing." S Q=1
S X=$P(^BNIGROUP(BNIGR,0),U,12) I X,$P(^BNISHT(X,0),U,5),$P($G(^BNIGROUP(BNIGR,11)),U,2)="" D
.W !,"SPECIFIC HEALTH TOPIC is ",$P(^BNISHT(X,0),U),!," and the text of SPECIFIC HEALTH TOPIC (OTHER) is missing." S Q=1
S X=$P(^BNIGROUP(BNIGR,0),U,13) I X,$P(^BNITOA(X,0),U,3),$P($G(^BNIGROUP(BNIGR,11)),U,3)="" D
.W !,"TYPE OF ACTIVITY is ",$P(^BNITOA(X,0),U),!," and the text of TYPE OF ACTIVITY (OTHER) is missing." S Q=1
S X=$P(^BNIGROUP(BNIGR,0),U,14) I X,$P(^BNIGS(X,0),U,3),$P($G(^BNIGROUP(BNIGR,12)),U,1)="" D
.W !,"GROUP SERVED is ",$P(^BNIGS(X,0),U),!," and the text of GROUP SERVED (OTHER) is missing." S Q=1
S X=$P(^BNIGROUP(BNIGR,0),U,15) I X,$P(^BNIAS(X,0),U,3),$P($G(^BNIGROUP(BNIGR,0)),U,16)="" D
.W !,"ACTIVITY SETTING is ",$P(^BNIAS(X,0),U),!," and the COMMUNITY is missing." S Q=1
I '$O(^BNIGROUP(BNIGR,16,0)) W !!,"You must enter at least one participating individual." S Q=1
Q
DELR ;
S DA=BNIGR,DIK="^BNIGROUP(" D ^DIK K DIK,DA
Q
PAUSE ;EP
S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
BNIG ; IHS/CMI/LAB - group entry for bni ;
+1 ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
+2 ;; ;
START ; Write Header
+1 ; -- kill all vars before starting
DO EOJ
+2 IF $DATA(IOF)
WRITE @IOF
+3 FOR J=1:1:13
SET X=$PIECE($TEXT(TEXT+J),";;",2)
WRITE !?80-$LENGTH(X)\2,X
+4 KILL X,J
START1 ;
+1 IF '$ORDER(^BNISITE(0))
WRITE !!,"Site parameters have not been set up. Please see the system manager."
DO PAUSE
DO EOJ
QUIT
+2 WRITE !!
+3 DO GETSITE
+4 IF BNISITE=""
DO EOJ
QUIT
+5 DO ADDQ
+6 IF BNIADDQ=""
GOTO START1
AGR ;
+1 DO FULL^VALM1
+2 WRITE !!
MNTH ;
+1 ;,DIR(0)="DO^:"_DT_":EPTX",DIR("A")="Enter Date of Activity" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
SET (BNIMNTH,BNIDATE,BNIYR)=""
+2 SET DIR(0)="S^1:JANUARY;2:FEBRUARY;3:MARCH;4:APRIL;5:MAY;6:JUNE;7:JULY;8:AUGUST;9:SEPTEMBER;10:OCTOBER;11:NOVEMBER;12:DECEMBER"
SET DIR("A")="Enter the MONTH the activity took place"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO PAUSE
GOTO EOJ
+4 SET BNIMNTH=Y
IF $LENGTH(BNIMNTH)=1
SET BNIMNTH="0"_BNIMNTH
YR ;
+1 SET BNIYR=""
+2 SET (BNIPER,BNIVDT)=""
+3 KILL DIR
SET DIR(0)="D^::EP"
SET DIR("B")=$$FMTE^XLFDT(($EXTRACT(DT,1,3)_"0000"))
+4 SET DIR("A")="Enter Year"
+5 SET DIR("?")="Enter the year the activity took place. E.g. 2006 or 06"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
DO PAUSE
GOTO MNTH
+8 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO YR
+9 SET BNIYR=Y
+10 SET BNIDATE=BNIYR
SET $EXTRACT(BNIDATE,4,5)=BNIMNTH
+11 IF BNIDATE>DT
WRITE !!,"Future dates are not allowed!",!
GOTO MNTH
+12 ;
ADDR ;
+1 KILL DIC
SET DIC(0)="EL"
SET DIC="^BNIGROUP("
SET DLAYGO=90510.5
SET DIADD=1
SET X=BNIDATE
+2 SET DIC("DR")=".02////"_DT_";.03////"_DUZ_";.06////"_DUZ(2)_";.07////"_DUZ(2)
+3 KILL DD,DO,D0
DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
+4 IF Y=-1
WRITE !!,$CHAR(7),$CHAR(7),"CPHAD Group Record is NOT complete!! Deleting Record.",!
DO PAUSE
DO EOJ
QUIT
+5 ;update multiple of user last update/date edited
+6 SET BNIGR=+Y
ADDR1 ;
+1 SET DA=BNIGR
SET DDSFILE=90510.5
SET DR=$SELECT($GET(BNIADDQ):"[BNIA GROUP ENTRY]",1:"[BNI GROUP ENTRY]")
DO ^DDS
+2 IF $DATA(DIMSG)
WRITE !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***"
DO PAUSE
DO EOJ
QUIT
+3 ;check record for completeness
+4 DO CHECKREC
+5 IF Q
Begin DoDot:1
+6 SET BNIA=""
KILL DIR
+7 SET DIR(0)="S^E:Edit and complete the Group Record;D:Delete the Incomplete Group Record"
SET DIR("A")="Do you wish to"
SET DIR("B")="E"
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
SET BNIA="D"
+9 SET BNIA=Y
End DoDot:1
IF BNIA="E"
GOTO ADDR1
DO DELR
DO PAUSE
DO EOJ
QUIT
GROUP ;
+1 WRITE !!,"I will now create an individual activity record for the following:"
+2 SET X=0
FOR
SET X=$ORDER(^BNIGROUP(BNIGR,16,X))
IF X'=+X
QUIT
WRITE !?5,$PIECE(^VA(200,$PIECE(^BNIGROUP(BNIGR,16,X,0),U),0),U)
+3 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
WRITE !!,"No records created."
DO PAUSE
DO EOJ
QUIT
+5 SET BNIX=0
FOR
SET BNIX=$ORDER(^BNIGROUP(BNIGR,16,BNIX))
IF BNIX'=+BNIX
QUIT
Begin DoDot:1
+6 SET BNIPRV=$PIECE(^BNIGROUP(BNIGR,16,BNIX,0),U)
+7 WRITE !,"Creating record for ",$PIECE(^VA(200,BNIPRV,0),U)
+8 KILL DIC
SET DIC(0)="EL"
SET DIC="^BNIREC("
SET DLAYGO=90510
SET DIADD=1
SET X=BNIDATE
+9 SET DIC("DR")=".02////"_DT_";.03////"_DUZ_";.06////"_DUZ(2)_";.08////"_BNIPRV
+10 KILL DD,DO,D0
DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
+11 IF Y=-1
WRITE !!,$CHAR(7),$CHAR(7),"Creating record for ",$PIECE(^VA(200,BNIPRV,0),U)," failed!! Deleting Record.",!
DO PAUSE
DO EOJ
QUIT
+12 ;update multiple of user last update/date edited
+13 SET BNIR=+Y
+14 SET DIE="^BNIREC("
SET DA=BNIR
SET DR="1500///NOW"
SET DR(2,90510.0115)=".02////^S X=DUZ"
DO ^DIE
KILL DIE,DA,DR
+15 FOR BNIZ=7,9,11:1:18
SET $PIECE(^BNIREC(BNIR,0),U,BNIZ)=$PIECE(^BNIGROUP(BNIGR,0),U,BNIZ)
+16 FOR BNIZ=1,2
IF $PIECE($GET(^BNIGROUP(BNIGR,11)),U,BNIZ)]""
SET $PIECE(^BNIREC(BNIR,11),U,BNIZ)=$PIECE(^BNIGROUP(BNIGR,0),U,BNIZ)
+17 FOR BNIZ=1
IF $PIECE($GET(^BNIGROUP(BNIGR,12)),U,BNIZ)]""
SET $PIECE(^BNIREC(BNIR,12),U,BNIZ)=$PIECE(^BNIGROUP(BNIGR,12),U,BNIZ)
+18 SET BNIW=0
FOR
SET BNIW=$ORDER(^BNIGROUP(BNIGR,14,BNIW))
IF BNIW'=+BNIW
QUIT
Begin DoDot:2
+19 SET ^BNIREC(BNIR,14,BNIW,0)=^BNIGROUP(BNIGR,14,BNIW,0)
+20 SET ^BNIREC(BNIR,14,0)="^^"_BNIW_"^"_BNIW_"^"_DT_"^"
End DoDot:2
+21 SET DA=BNIR
SET DIK="^BNIREC("
DO IX1^DIK
End DoDot:1
+22 WRITE !,"Records created."
+23 DO PAUSE
+24 DO EOJ
+25 QUIT
+26 ;
EOJ ;EOJ CLEANUP
+1 DO CLEAR^VALM1
+2 DO EN^XBVK("BNI")
+3 QUIT
GETSITE ;
+1 SET BNISITE=""
+2 WRITE !
KILL DIC
SET DIC="^BNISITE("
SET DIC("A")="Enter your Site: "
SET DIC("B")=$PIECE(^DIC(4,DUZ(2),0),U)
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+3 IF Y=-1
QUIT
+4 SET BNISITE=+Y
+5 QUIT
ADDQ ;
+1 SET BNIADDQ=""
+2 WRITE !
+3 KILL DIR
+4 SET DIR(0)="Y"
SET DIR("A")="Do you want to be prompted for Travel Time and Number Served"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
QUIT
+6 SET BNIADDQ=Y
+7 QUIT
DATE(D) ;
+1 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)
+2 ;
+3 ;
TEXT ;
+1 ;;Computerized Public Health Activity (CPHAD) Group Data Entry
+2 ;;
+3 ;;***************************************
+4 ;;* Update CPHAD Group Activity Records *
+5 ;;***************************************
+6 ;;
+7 ;;This option is used to enter a GROUP Activity Record.
+8 ;;You will be asked to enter all information about the activity
+9 ;;including all persons who participated in the activity.
+10 ;;When all information is entered a public health activity record
+11 ;;will be generated for each person who participated in the
+12 ;;group activity.
+13 ;;
+14 QUIT
SHT(G) ;EP - called from screenman screen
+1 IF $GET(G)=""
QUIT ""
+2 NEW X
+3 SET X=$ORDER(^BNISHT("AA",G,1,0))
+4 IF X
IF $DATA(^BNISHT(X,0))
QUIT $PIECE(^BNISHT(X,0),U,1)
+5 QUIT ""
GHCPOST ;EP - called from screenman
+1 ;require other if Other
DO REQ^DDSUTL(4,2,1,$SELECT('$GET(X):0,$PIECE(^BNIGHC(X,0),U,3)=1:1,1:0))
+2 ;empty out 1101 if not Other
IF 'X
DO PUT^DDSVAL(DIE,.DA,1101,"")
+3 IF X
IF '$PIECE(^BNIGHC(X,0),U,3)
DO PUT^DDSVAL(DIE,.DA,1101,"")
+4 ;don't allow field 7 if not other
DO UNED^DDSUTL(4,2,1,$SELECT('$GET(X):1,$PIECE(^BNIGHC(X,0),U,3)=1:0,1:1))
+5 SET BNISMGNC=X
+6 NEW Z
+7 SET Z=$$GET^DDSVAL(DIE,.DA,.12)
+8 IF Z=""
DO PUT^DDSVAL(DIE,.DA,.12,$$SHT(BNISMGNC))
+9 IF Z]""
Begin DoDot:1
+10 IF $PIECE(^BNISHT(Z,0),U,3)=BNISMGNC
QUIT
+11 DO PUT^DDSVAL(DIE,.DA,.12,$$SHT(BNISMGNC))
+12 QUIT
End DoDot:1
+13 DO REFRESH^DDSUTL
+14 QUIT
SHTPOST ;EP - called from screenman
+1 ;require other if Other
DO REQ^DDSUTL(6,2,1,$SELECT('$GET(X):0,$PIECE(^BNISHT(X,0),U,5)=1:1,1:0))
+2 ;empty out 1101 if not Other
IF 'X
DO PUT^DDSVAL(DIE,.DA,1102,"")
+3 IF X
IF '$PIECE(^BNISHT(X,0),U,5)
DO PUT^DDSVAL(DIE,.DA,1102,"")
+4 ;don't allow field 8 if not other
DO UNED^DDSUTL(6,2,1,$SELECT('$GET(X):1,$PIECE(^BNISHT(X,0),U,5)=1:0,1:1))
+5 DO REFRESH^DDSUTL
+6 QUIT
TOAPOST ;EP - called from screenman
+1 ;require other if Other
DO REQ^DDSUTL(8,2,1,$SELECT('$GET(X):0,$PIECE(^BNITOA(X,0),U,3)=1:1,1:0))
+2 ;empty out 1101 if not Other
IF 'X
DO PUT^DDSVAL(DIE,.DA,1103,"")
+3 IF X
IF '$PIECE(^BNITOA(X,0),U,3)
DO PUT^DDSVAL(DIE,.DA,1103,"")
+4 ;don't allow field 8 if not other
DO UNED^DDSUTL(8,2,1,$SELECT('$GET(X):1,$PIECE(^BNITOA(X,0),U,3)=1:0,1:1))
+5 DO REFRESH^DDSUTL
+6 QUIT
GSPOST ;EP - called from screenman
+1 ;require other if Other
DO REQ^DDSUTL(10,2,1,$SELECT('$GET(X):0,$PIECE(^BNIGS(X,0),U,3)=1:1,1:0))
+2 ;empty out 1101 if not Other
IF 'X
DO PUT^DDSVAL(DIE,.DA,1104,"")
+3 IF X
IF '$PIECE(^BNIGS(X,0),U,3)
DO PUT^DDSVAL(DIE,.DA,1104,"")
+4 ;don't allow field 10 if not other
DO UNED^DDSUTL(10,2,1,$SELECT('$GET(X):1,$PIECE(^BNIGS(X,0),U,3)=1:0,1:1))
+5 DO REFRESH^DDSUTL
+6 QUIT
ASPOST ;EP - called from screenman
+1 ;require other if Other
DO REQ^DDSUTL(12,2,1,$SELECT('$GET(X):0,$PIECE(^BNIAS(X,0),U,3)=1:1,1:0))
+2 ;empty out 1101 if not Other
IF 'X
DO PUT^DDSVAL(DIE,.DA,.16,"")
+3 IF X
IF '$PIECE(^BNIAS(X,0),U,3)
DO PUT^DDSVAL(DIE,.DA,.16,"")
+4 ;don't allow field 12 if not other
DO UNED^DDSUTL(12,2,1,$SELECT('$GET(X):1,$PIECE(^BNIAS(X,0),U,3)=1:0,1:1))
+5 DO REFRESH^DDSUTL
+6 QUIT
SHTSCR(I) ;EP - called from screen on dd 90510 FIELD .12
+1 IF '$GET(BNISMGNC)
QUIT 1
+2 IF $PIECE(^BNISHT(I,0),U,3)'=BNISMGNC
QUIT 0
+3 QUIT 1
COMM(I) ;EP - called from screen on dd 90510 field .16
+1 IF '$GET(BNISITE)
QUIT 1
+2 NEW Z,C
+3 SET Z=$PIECE($GET(^BNISITE(BNISITE,0)),U,3)
+4 IF 'Z
QUIT 1
+5 SET C=$PIECE(^AUTTCOM(Y,0),U)
+6 IF '$DATA(^ATXAX(Z,0))
QUIT 1
+7 IF '$DATA(^ATXAX(Z,21,"B",C))
QUIT 0
+8 QUIT 1
CHECKREC ;
+1 SET Q=""
FOR F=.07,.09,.11,.12,.13
IF $PIECE(^BNIGROUP(BNIGR,0),U,+$PIECE(F,".",2))=""
Begin DoDot:1
+2 WRITE !,$PIECE(^DD(90510,F,0),U)," is a required field and is missing."
SET Q=1
End DoDot:1
+3 IF $PIECE($GET(^BNISITE(BNISITE,0)),U,2)
IF $PIECE(^BNIGROUP(BNIGR,0),U,15)=""
Begin DoDot:1
+4 WRITE !,"ACTIVITY SETTING is required and is missing."
SET Q=1
End DoDot:1
+5 SET X=$PIECE(^BNIGROUP(BNIGR,0),U,11)
IF X
IF $PIECE(^BNIGHC(X,0),U,3)
IF $PIECE($GET(^BNIGROUP(BNIGR,11)),U,1)=""
Begin DoDot:1
+6 WRITE !,"GENERAL HEALTH CONCERN is ",$PIECE(^BNIGHC(X,0),U),!," and the text of GENERAL HEALTH CONCERN (OTHER) is missing."
SET Q=1
End DoDot:1
+7 SET X=$PIECE(^BNIGROUP(BNIGR,0),U,12)
IF X
IF $PIECE(^BNISHT(X,0),U,5)
IF $PIECE($GET(^BNIGROUP(BNIGR,11)),U,2)=""
Begin DoDot:1
+8 WRITE !,"SPECIFIC HEALTH TOPIC is ",$PIECE(^BNISHT(X,0),U),!," and the text of SPECIFIC HEALTH TOPIC (OTHER) is missing."
SET Q=1
End DoDot:1
+9 SET X=$PIECE(^BNIGROUP(BNIGR,0),U,13)
IF X
IF $PIECE(^BNITOA(X,0),U,3)
IF $PIECE($GET(^BNIGROUP(BNIGR,11)),U,3)=""
Begin DoDot:1
+10 WRITE !,"TYPE OF ACTIVITY is ",$PIECE(^BNITOA(X,0),U),!," and the text of TYPE OF ACTIVITY (OTHER) is missing."
SET Q=1
End DoDot:1
+11 SET X=$PIECE(^BNIGROUP(BNIGR,0),U,14)
IF X
IF $PIECE(^BNIGS(X,0),U,3)
IF $PIECE($GET(^BNIGROUP(BNIGR,12)),U,1)=""
Begin DoDot:1
+12 WRITE !,"GROUP SERVED is ",$PIECE(^BNIGS(X,0),U),!," and the text of GROUP SERVED (OTHER) is missing."
SET Q=1
End DoDot:1
+13 SET X=$PIECE(^BNIGROUP(BNIGR,0),U,15)
IF X
IF $PIECE(^BNIAS(X,0),U,3)
IF $PIECE($GET(^BNIGROUP(BNIGR,0)),U,16)=""
Begin DoDot:1
+14 WRITE !,"ACTIVITY SETTING is ",$PIECE(^BNIAS(X,0),U),!," and the COMMUNITY is missing."
SET Q=1
End DoDot:1
+15 IF '$ORDER(^BNIGROUP(BNIGR,16,0))
WRITE !!,"You must enter at least one participating individual."
SET Q=1
+16 QUIT
DELR ;
+1 SET DA=BNIGR
SET DIK="^BNIGROUP("
DO ^DIK
KILL DIK,DA
+2 QUIT
PAUSE ;EP
+1 SET DIR(0)="EO"
SET DIR("A")="Press enter to continue...."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 QUIT
