BCHEGP ; IHS/CMI/LAB - group preventive services group form ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;
START ;
D INIT
K BCHQUIT
D GETDATA
I $D(BCHQUIT) W !!,"Exiting group form entry" H 2 D EOJ Q
D ^BCHEGP1
;print forms?
PRINT ;
W !! S DIR(0)="Y",DIR("A")="Do you wish to PRINT a hard copy encounter form for each patient in the group",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
Q:'Y
S XBRP="PRINT1^BCHEGP",XBRC="",XBRX="EOJ^BCHEGP",XBNS="BCH"
D ^XBDBQUE
;loop through all patients, records and print forms
W !!!!
Q
PRINT1 ;
S BCHR=0 F S BCHR=$O(^BCHGROUP(BCHFID,21,BCHR)) Q:BCHR'=+BCHR!($G(BCHQUIT)) D PRINT1^BCHUFPP
Q
INIT ; Write Header
D ^XBFMK K DIADD,DLAYGO
D TERM^VALM0
W:$D(IOF) @IOF
F BCHEGJ=1:1:11 S BCHEGX=$P($T(TEXT+BCHEGJ),";;",2) W !?80-$L(BCHEGX)\2,BCHEGX
K BCHEGX,BCHEGJ
W !!
S BCHQUIT=""
D ^BCHUIN
K ^TMP("BCHEGP",$J)
D KILL^AUPNPAT
Q
EOJ ;
D EN^XBVK("BCH")
K AUPNPAT,AUPNDAYS,AUPNSEX,AUPNDOB,AUPNDOD
K %,%W,%Y,X,Y,DIR,DIRUT,DIC,DIE,DA,DR,DTOUT,DUOUT,%DT,DIU,DIV,DIW,DIPGM,DQ,DI,DIG,DIH,X1,X2,ZTSAVE
D ^XBFMK K DIADD,DLAYGO
Q
GETDATA ; GET LOCATION OF ENCOUNTER
W !
;create new group form entry
S X="XXX",DIADD=1,DLAYGO=90002.97,DIC="^BCHGROUP(",DIC(0)="L" K DD,DO D FILE^DICN
K DIADD,DLAYGO,DIC
I Y=-1 W !!,"error creating group entry." S BCHQUIT=1
S BCHFID=+Y
D ^XBFMK
S DA=BCHFID,Z="G"_BCHFID,DIE="^BCHGROUP(",DR=".01///"_Z D ^DIE K DIE,DR,DA
W !!,"The form ID for this group form is ",$P(^BCHGROUP(BCHFID,0),U),".",!,"Please make a note of this. It will be needed if and when you need to ",!,"re-print forms.",!!
K DIR S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR
EDIT ;
S DA=BCHFID,DDSFILE=90002.97,DR="[BCH GROUP ENTRY]" D ^DDS
I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***" S BCHQUIT=1 K DIMSG Q
S C=0 I '$O(^BCHRGAS("AD",BCHFID,0)) W !!,"At least one POV is required!" S C=1
F X=1:1:4,6,11,12 I $P(^BCHGROUP(BCHFID,0),U,X)="" S C=1
S Y=0 F S Y=$O(^BCHRGAS("AD",BCHFID,Y)) Q:Y'=+Y F X=1,4,5,6 I $P(^BCHRGAS(Y,0),U,X)="" S C=1
I C W !!,"Not all required data elements have been entered." D G:Y="E" EDIT W !,"Deleting group definition..." D DELGRP Q
.S DIR(0)="S^E:Edit and Complete the Group Definition;D:Delete the Incomplete Definition",DIR("A")="What do you want to do",DIR("B")="E" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) S Y="D"
.Q
Q:$D(BCHQUIT)
S BCHNUM=$P(^BCHGROUP(BCHFID,0),U,12)
;DISPLAY AND CONFIRM
W !!,"I am going to ask you to enter ",BCHNUM," patient names. I will then create a",!,"record in the CHR file for each patient. The record will contain the",!,"following information: ",!
S DIC="^BCHGROUP(",DA=BCHFID,DR="0" D EN^DIQ K DIC
S BCHX=0 F S BCHX=$O(^BCHRGAS("AD",BCHFID,BCHX)) Q:BCHX'=+BCHX S DA=BCHX,DIC="^BCHRGAS(",DR=0 D EN^DIQ K DIC
K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) S BCHQUIT=1 Q
I 'Y S BCHQUIT=1 Q
Q
;
;
FORMID ;
;generate form id in file
K DIC,DO,DD,D0 S X="XXX",DIC(0)="L",DIC="^BCHGROUP(",DIADD=1,DLAYGO=9001002.3,DIC("DR")=".02////"_DUZ_";.03////"_DT_";.04////"_BCHDATE D FILE^DICN I Y=-1 D Q
.D ^XBFMK K DIADD,DLAYGO,DLAYGO,DR,DD S BCHQUIT=1 W !!,"Failure to create FORM ID. Notify programmer.",! Q
S BCHFID=+Y
K DIADD,DLAYGO D ^XBFMK
S DA=BCHFID,Z="G"_BCHFID,DIE="^BCHGROUP(",DR=".01///"_Z D ^DIE K DIE,DR,DA
W !,"The form ID for this group form is ",$P(^BCHGRP(BCHFID,0),U),".",!,"Please make a note of this. It will be needed if and when you need to ",!,"re-print forms.",!
Q
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR("A")="Press Enter",DIR(0)="E" D ^DIR
Q
;----------
TEXT ;
;;IHS/RPMS CHR REPORTING SYSTEM
;;
;;*************************
;;* GROUP FORM ENTER Mode *
;;*************************
;;
;;You will be asked to enter the data that will be included
;;on each patient's visit. You will then be asked to enter
;;each patient's name who attended the group session. Afer
;;that you will be given the opportunity to add measurements
;;and/or edit each patient's visit record.
;;
;
REPRINT ;EP - called from option
D RXIT
W:$D(IOF) @IOF
W !!,"This option should be used to print or re-print group encounter forms.",!!,"You must know the group ID form number or the date of the group visit."
W !!,"Only group forms entered after PCC Data Entry Patch 5 was installed",!,"are available for re-printing.",!!
W !!,"Please enter the group ID form or the date of the visit.",!
D ^XBFMK
S DIC="^BCHGROUP(",DIC(0)="AEMQ" D ^DIC
I Y=-1 W !!,"No form selected" H 2 D RXIT Q
S BCHFID=+Y
S X=0 F S X=$O(^BCHGROUP(BCHFID,21,X)) Q:X'=+X S BCHEGP("FORMS",X)=""
I '$D(BCHEGP("FORMS")) W !!,"There are no visits to print.",! H 2 D RXIT Q
W !,"The following visit forms will be printed: "
S X=0 F S X=$O(BCHEGP("FORMS",X)) Q:X'=+X D
.W !?5,$$VAL^XBDIQ1(90002,X,.01),?30,$$VAL^XBDIQ1(90002,X,.04)
D PRINT
D RXIT
Q
RXIT ;
D EN^XBVK("BCH")
D ^XBFMK
D KILL^AUPNPAT
Q
DELGRP ;
NEW BCHX
S BCHX=0 F S BCHX=$O(^BCHRGAS("AD",BCHFID,BCHX)) Q:BCHX'=+BCHX S DIK="^BCHRGAS(",DA=BCHX D ^DIK
S DA=BCHFID,DIK="^BCHGROUP" D ^DIK K DIK,DA S BCHQUIT=1 K DIR S DIR(0)="E" D ^DIR K DIR
Q
BCHEGP ; IHS/CMI/LAB - group preventive services group form ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;
START ;
+1 DO INIT
+2 KILL BCHQUIT
+3 DO GETDATA
+4 IF $DATA(BCHQUIT)
WRITE !!,"Exiting group form entry"
HANG 2
DO EOJ
QUIT
+5 DO ^BCHEGP1
+6 ;print forms?
PRINT ;
+1 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you wish to PRINT a hard copy encounter form for each patient in the group"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
QUIT
+3 IF 'Y
QUIT
+4 SET XBRP="PRINT1^BCHEGP"
SET XBRC=""
SET XBRX="EOJ^BCHEGP"
SET XBNS="BCH"
+5 DO ^XBDBQUE
+6 ;loop through all patients, records and print forms
+7 WRITE !!!!
+8 QUIT
PRINT1 ;
+1 SET BCHR=0
FOR
SET BCHR=$ORDER(^BCHGROUP(BCHFID,21,BCHR))
IF BCHR'=+BCHR!($GET(BCHQUIT))
QUIT
DO PRINT1^BCHUFPP
+2 QUIT
INIT ; Write Header
+1 DO ^XBFMK
KILL DIADD,DLAYGO
+2 DO TERM^VALM0
+3 IF $DATA(IOF)
WRITE @IOF
+4 FOR BCHEGJ=1:1:11
SET BCHEGX=$PIECE($TEXT(TEXT+BCHEGJ),";;",2)
WRITE !?80-$LENGTH(BCHEGX)\2,BCHEGX
+5 KILL BCHEGX,BCHEGJ
+6 WRITE !!
+7 SET BCHQUIT=""
+8 DO ^BCHUIN
+9 KILL ^TMP("BCHEGP",$JOB)
+10 DO KILL^AUPNPAT
+11 QUIT
EOJ ;
+1 DO EN^XBVK("BCH")
+2 KILL AUPNPAT,AUPNDAYS,AUPNSEX,AUPNDOB,AUPNDOD
+3 KILL %,%W,%Y,X,Y,DIR,DIRUT,DIC,DIE,DA,DR,DTOUT,DUOUT,%DT,DIU,DIV,DIW,DIPGM,DQ,DI,DIG,DIH,X1,X2,ZTSAVE
+4 DO ^XBFMK
KILL DIADD,DLAYGO
+5 QUIT
GETDATA ; GET LOCATION OF ENCOUNTER
+1 WRITE !
+2 ;create new group form entry
+3 SET X="XXX"
SET DIADD=1
SET DLAYGO=90002.97
SET DIC="^BCHGROUP("
SET DIC(0)="L"
KILL DD,DO
DO FILE^DICN
+4 KILL DIADD,DLAYGO,DIC
+5 IF Y=-1
WRITE !!,"error creating group entry."
SET BCHQUIT=1
+6 SET BCHFID=+Y
+7 DO ^XBFMK
+8 SET DA=BCHFID
SET Z="G"_BCHFID
SET DIE="^BCHGROUP("
SET DR=".01///"_Z
DO ^DIE
KILL DIE,DR,DA
+9 WRITE !!,"The form ID for this group form is ",$PIECE(^BCHGROUP(BCHFID,0),U),".",!,"Please make a note of this. It will be needed if and when you need to ",!,"re-print forms.",!!
+10 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press enter to continue"
DO ^DIR
KILL DIR
EDIT ;
+1 SET DA=BCHFID
SET DDSFILE=90002.97
SET DR="[BCH GROUP ENTRY]"
DO ^DDS
+2 IF $DATA(DIMSG)
WRITE !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***"
SET BCHQUIT=1
KILL DIMSG
QUIT
+3 SET C=0
IF '$ORDER(^BCHRGAS("AD",BCHFID,0))
WRITE !!,"At least one POV is required!"
SET C=1
+4 FOR X=1:1:4,6,11,12
IF $PIECE(^BCHGROUP(BCHFID,0),U,X)=""
SET C=1
+5 SET Y=0
FOR
SET Y=$ORDER(^BCHRGAS("AD",BCHFID,Y))
IF Y'=+Y
QUIT
FOR X=1,4,5,6
IF $PIECE(^BCHRGAS(Y,0),U,X)=""
SET C=1
+6 IF C
WRITE !!,"Not all required data elements have been entered."
Begin DoDot:1
+7 SET DIR(0)="S^E:Edit and Complete the Group Definition;D:Delete the Incomplete Definition"
SET DIR("A")="What do you want to do"
SET DIR("B")="E"
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
SET Y="D"
+9 QUIT
End DoDot:1
IF Y="E"
GOTO EDIT
WRITE !,"Deleting group definition..."
DO DELGRP
QUIT
+10 IF $DATA(BCHQUIT)
QUIT
+11 SET BCHNUM=$PIECE(^BCHGROUP(BCHFID,0),U,12)
+12 ;DISPLAY AND CONFIRM
+13 WRITE !!,"I am going to ask you to enter ",BCHNUM," patient names. I will then create a",!,"record in the CHR file for each patient. The record will contain the",!,"following information: ",!
+14 SET DIC="^BCHGROUP("
SET DA=BCHFID
SET DR="0"
DO EN^DIQ
KILL DIC
+15 SET BCHX=0
FOR
SET BCHX=$ORDER(^BCHRGAS("AD",BCHFID,BCHX))
IF BCHX'=+BCHX
QUIT
SET DA=BCHX
SET DIC="^BCHRGAS("
SET DR=0
DO EN^DIQ
KILL DIC
+16 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+17 IF $DATA(DIRUT)
SET BCHQUIT=1
QUIT
+18 IF 'Y
SET BCHQUIT=1
QUIT
+19 QUIT
+20 ;
+21 ;
FORMID ;
+1 ;generate form id in file
+2 KILL DIC,DO,DD,D0
SET X="XXX"
SET DIC(0)="L"
SET DIC="^BCHGROUP("
SET DIADD=1
SET DLAYGO=9001002.3
SET DIC("DR")=".02////"_DUZ_";.03////"_DT_";.04////"_BCHDATE
DO FILE^DICN
IF Y=-1
Begin DoDot:1
+3 DO ^XBFMK
KILL DIADD,DLAYGO,DLAYGO,DR,DD
SET BCHQUIT=1
WRITE !!,"Failure to create FORM ID. Notify programmer.",!
QUIT
End DoDot:1
QUIT
+4 SET BCHFID=+Y
+5 KILL DIADD,DLAYGO
DO ^XBFMK
+6 SET DA=BCHFID
SET Z="G"_BCHFID
SET DIE="^BCHGROUP("
SET DR=".01///"_Z
DO ^DIE
KILL DIE,DR,DA
+7 WRITE !,"The form ID for this group form is ",$PIECE(^BCHGRP(BCHFID,0),U),".",!,"Please make a note of this. It will be needed if and when you need to ",!,"re-print forms.",!
+8 QUIT
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR("A")="Press Enter"
SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
TEXT ;
+1 ;;IHS/RPMS CHR REPORTING SYSTEM
+2 ;;
+3 ;;*************************
+4 ;;* GROUP FORM ENTER Mode *
+5 ;;*************************
+6 ;;
+7 ;;You will be asked to enter the data that will be included
+8 ;;on each patient's visit. You will then be asked to enter
+9 ;;each patient's name who attended the group session. Afer
+10 ;;that you will be given the opportunity to add measurements
+11 ;;and/or edit each patient's visit record.
+12 ;;
+13 ;
REPRINT ;EP - called from option
+1 DO RXIT
+2 IF $DATA(IOF)
WRITE @IOF
+3 WRITE !!,"This option should be used to print or re-print group encounter forms.",!!,"You must know the group ID form number or the date of the group visit."
+4 WRITE !!,"Only group forms entered after PCC Data Entry Patch 5 was installed",!,"are available for re-printing.",!!
+5 WRITE !!,"Please enter the group ID form or the date of the visit.",!
+6 DO ^XBFMK
+7 SET DIC="^BCHGROUP("
SET DIC(0)="AEMQ"
DO ^DIC
+8 IF Y=-1
WRITE !!,"No form selected"
HANG 2
DO RXIT
QUIT
+9 SET BCHFID=+Y
+10 SET X=0
FOR
SET X=$ORDER(^BCHGROUP(BCHFID,21,X))
IF X'=+X
QUIT
SET BCHEGP("FORMS",X)=""
+11 IF '$DATA(BCHEGP("FORMS"))
WRITE !!,"There are no visits to print.",!
HANG 2
DO RXIT
QUIT
+12 WRITE !,"The following visit forms will be printed: "
+13 SET X=0
FOR
SET X=$ORDER(BCHEGP("FORMS",X))
IF X'=+X
QUIT
Begin DoDot:1
+14 WRITE !?5,$$VAL^XBDIQ1(90002,X,.01),?30,$$VAL^XBDIQ1(90002,X,.04)
End DoDot:1
+15 DO PRINT
+16 DO RXIT
+17 QUIT
RXIT ;
+1 DO EN^XBVK("BCH")
+2 DO ^XBFMK
+3 DO KILL^AUPNPAT
+4 QUIT
DELGRP ;
+1 NEW BCHX
+2 SET BCHX=0
FOR
SET BCHX=$ORDER(^BCHRGAS("AD",BCHFID,BCHX))
IF BCHX'=+BCHX
QUIT
SET DIK="^BCHRGAS("
SET DA=BCHX
DO ^DIK
+3 SET DA=BCHFID
SET DIK="^BCHGROUP"
DO ^DIK
KILL DIK,DA
SET BCHQUIT=1
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+4 QUIT
