BWGRVL1 ; IHS/CMI/LAB - PROCESS VISIT LIST ;15-Feb-2003 21:52;PLS
;;2.0;WOMEN'S HEALTH;**6,8**;MAY 16, 1996
;
;
;
START ;
S (BWGRBT,BWGRBTH)=$H,BWGRJOB=$J,BWGRRCNT=0
D XTMP^BWGRVLU("BWGRVL","WH GENERAL RETRIEVAL")
D @BWGRTYPE,END
Q
;
RP ;run with search template of patients, visit gen
S X1=BWGRBD,X2=-1 D C^%DTC S BWGRSD=X
S BWGRODAT=BWGRSD_".9999" F S BWGRODAT=$O(^BWPCD("D",BWGRODAT)) Q:BWGRODAT=""!((BWGRODAT\1)>BWGRED) D VP1
Q
VP1 ;
S BWGRVIEN="" F S BWGRVIEN=$O(^BWPCD("D",BWGRODAT,BWGRVIEN)) Q:BWGRVIEN'=+BWGRVIEN I $D(^BWPCD(BWGRVIEN,0)) S DFN=$P(^BWPCD(BWGRVIEN,0),U,2) D
.Q:'$D(^DIBT(BWGRSEAT,1,DFN)) ;quit if patient not in search template
.D PROC
.Q
Q
VV ;run by search template
S BWGRVIEN=0 F S BWGRVIEN=$O(^DIBT(BWGRSEAT,1,BWGRVIEN)) Q:BWGRVIEN'=+BWGRVIEN I $D(^BWPCD(BWGRVIEN,0)) D
.S X=$P($P(^BWPCD(BWGRVIEN,0),U),".")
.Q:X>BWGRED
.Q:X<BWGRBD
.D PROC
.Q
Q
RS ; Run by visit date
S X1=BWGRBD,X2=-1 D C^%DTC S BWGRSD=X
S BWGRODAT=BWGRSD_".9999" F S BWGRODAT=$O(^BWPCD("D",BWGRODAT)) Q:BWGRODAT=""!((BWGRODAT\1)>BWGRED) D V1
Q
;
PP ;
S BWGRVIEN=0 F S BWGRVIEN=$O(^BWP(BWGRVIEN)) Q:BWGRVIEN'=+BWGRVIEN D PROC
Q
;
PS ;
S BWGRVIEN=0 F S BWGRVIEN=$O(^DIBT(BWGRSEAT,1,BWGRVIEN)) Q:BWGRVIEN'=+BWGRVIEN I $D(^BWP(BWGRVIEN,0)) D PROC
Q
;
;
END ;
S BWGRET=$H
Q
V1 ;
S BWGRVIEN="" F S BWGRVIEN=$O(^BWPCD("D",BWGRODAT,BWGRVIEN)) Q:BWGRVIEN'=+BWGRVIEN I $D(^BWPCD(BWGRVIEN,0)) D PROC
Q
PROC ;
K BWGRSPEC,BWGRVREC,BWGRPREC,DFN
I BWGRPTVS="R" S BWGRVREC=^BWPCD(BWGRVIEN,0),DFN=$P(BWGRVREC,U,2)
I BWGRPTVS="P" S DFN=BWGRVIEN,BWGRVREC=""
S BWGRPREC=^BWP(DFN,0)
D SCREENS
Q:$D(BWGRSKIP)
K BWGRSRT,BWGRPRNT S BWGRCRIT=BWGRSORT,BWGRX=0
X:$D(^BWGRI(BWGRSORT,4)) ^BWGRI(BWGRSORT,4) I '$D(BWGRPRNT) D
. I BWGRPTVS="R" S Y=$P($P(BWGRVREC,U),".") S BWGRPRNT=Y Q
. S BWGRPRNT=$P(^DPT(DFN,0),U)
.Q
S BWGRSRT=BWGRPRNT
D SUBPAT
S ^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"DATA HITS",BWGRSRT,BWGRVIEN)="",BWGRRCNT=BWGRRCNT+1
Q:$D(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"PATIENTS",DFN))
S ^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"PATIENTS",DFN)="",BWGRPTCT=BWGRPTCT+1
Q
SUBPAT ;tally # of patients by sort value on detailed/subtotal
Q:BWGRCTYP="C"
Q:BWGRCTYP="F"
Q:BWGRCTYP="T"
S:$G(BWGRSRT)="" BWGRSRT="????"
Q:$D(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PATIENT HIT",BWGRSRT,DFN))
S:'$D(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRT)) ^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRT)=0
S ^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRT)=^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRT)+1
Q:$D(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PATIENT HIT",BWGRSRT,DFN))
S ^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PATIENT HIT",BWGRSRT,DFN)=""
Q
SCREENS ;
K BWGRSKIP
S BWGRI=0 F S BWGRI=$O(^BWGRTRPT(BWGRRPT,11,BWGRI)) Q:BWGRI'=+BWGRI!($D(BWGRSKIP)) D
.I '$P(^BWGRI(BWGRI,0),U,8) D SINGLE Q
.D MULT
.Q
Q
SINGLE ;
K X,BWGRSPEC S X="",BWGRX=0
X:$D(^BWGRI(BWGRI,1)) ^(1)
I X="" S BWGRSKIP="" Q
I '$D(BWGRSPEC),'$D(^BWGRTRPT(BWGRRPT,11,BWGRI,11,"B",X)) S BWGRSKIP="" Q
Q
MULT ;
K BWGRFOUN,BWGRSKIP,BWGRSPEC,X S BWGRX=0,X=""
X:$D(^BWGRI(BWGRI,1)) ^(1)
I $O(X(""))="" S BWGRSKIP="" Q
I '$D(BWGRSPEC) S Y="" F S Y=$O(X(Y)) Q:Y="" I $D(^BWGRTRPT(BWGRRPT,11,BWGRI,11,"B",Y)) S BWGRFOUN="" Q
I $D(BWGRSPEC),$G(X) S BWGRFOUN=1 Q
S:'$D(BWGRFOUN) BWGRSKIP=""
Q
XIT ;EP - CALLED FROM BWGRVL
D EN^XBVK("BWGR"),EN^XBVK("AMQQ"),EN^XBVK("AUPN")
XIT1 ;EP
K BWGRANS,BWGRBTH,BWGRC,BWGRCNT,BWGRCRIT,BWGRCUT,BWGRD,BWGRDISP,BWGRDONE,BWGRHIGH,BWGRI,BWGRJOB,BWGRQMAN,BWGRSEL,BWGRTEXT,BWGRVAR,BWGRSKIP,BWGRPRNT,BWGRPRNM,BWGRLINE,BWGRRCNT,BWGRSCNT,BWGRDFET,BWGRY,DFN
K X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M,ZTIO,DUOUT,DIR,DTOUT,V,Z,I,DIC,DIK,DIADD,DLAYGO,DA,DR,DIE,DIU,AMQQTAX,DINUM,BWGRPACK,BWGREP1,BWGREP2,D,BWGRLENG,BWGRLHDR,BWGRSAVE,AMQQND
Q
BWGRVL1 ; IHS/CMI/LAB - PROCESS VISIT LIST ;15-Feb-2003 21:52;PLS
+1 ;;2.0;WOMEN'S HEALTH;**6,8**;MAY 16, 1996
+2 ;
+3 ;
+4 ;
START ;
+1 SET (BWGRBT,BWGRBTH)=$HOROLOG
SET BWGRJOB=$JOB
SET BWGRRCNT=0
+2 DO XTMP^BWGRVLU("BWGRVL","WH GENERAL RETRIEVAL")
+3 DO @BWGRTYPE
DO END
+4 QUIT
+5 ;
RP ;run with search template of patients, visit gen
+1 SET X1=BWGRBD
SET X2=-1
DO C^%DTC
SET BWGRSD=X
+2 SET BWGRODAT=BWGRSD_".9999"
FOR
SET BWGRODAT=$ORDER(^BWPCD("D",BWGRODAT))
IF BWGRODAT=""!((BWGRODAT\1)>BWGRED)
QUIT
DO VP1
+3 QUIT
VP1 ;
+1 SET BWGRVIEN=""
FOR
SET BWGRVIEN=$ORDER(^BWPCD("D",BWGRODAT,BWGRVIEN))
IF BWGRVIEN'=+BWGRVIEN
QUIT
IF $DATA(^BWPCD(BWGRVIEN,0))
SET DFN=$PIECE(^BWPCD(BWGRVIEN,0),U,2)
Begin DoDot:1
+2 ;quit if patient not in search template
IF '$DATA(^DIBT(BWGRSEAT,1,DFN))
QUIT
+3 DO PROC
+4 QUIT
End DoDot:1
+5 QUIT
VV ;run by search template
+1 SET BWGRVIEN=0
FOR
SET BWGRVIEN=$ORDER(^DIBT(BWGRSEAT,1,BWGRVIEN))
IF BWGRVIEN'=+BWGRVIEN
QUIT
IF $DATA(^BWPCD(BWGRVIEN,0))
Begin DoDot:1
+2 SET X=$PIECE($PIECE(^BWPCD(BWGRVIEN,0),U),".")
+3 IF X>BWGRED
QUIT
+4 IF X<BWGRBD
QUIT
+5 DO PROC
+6 QUIT
End DoDot:1
+7 QUIT
RS ; Run by visit date
+1 SET X1=BWGRBD
SET X2=-1
DO C^%DTC
SET BWGRSD=X
+2 SET BWGRODAT=BWGRSD_".9999"
FOR
SET BWGRODAT=$ORDER(^BWPCD("D",BWGRODAT))
IF BWGRODAT=""!((BWGRODAT\1)>BWGRED)
QUIT
DO V1
+3 QUIT
+4 ;
PP ;
+1 SET BWGRVIEN=0
FOR
SET BWGRVIEN=$ORDER(^BWP(BWGRVIEN))
IF BWGRVIEN'=+BWGRVIEN
QUIT
DO PROC
+2 QUIT
+3 ;
PS ;
+1 SET BWGRVIEN=0
FOR
SET BWGRVIEN=$ORDER(^DIBT(BWGRSEAT,1,BWGRVIEN))
IF BWGRVIEN'=+BWGRVIEN
QUIT
IF $DATA(^BWP(BWGRVIEN,0))
DO PROC
+2 QUIT
+3 ;
+4 ;
END ;
+1 SET BWGRET=$HOROLOG
+2 QUIT
V1 ;
+1 SET BWGRVIEN=""
FOR
SET BWGRVIEN=$ORDER(^BWPCD("D",BWGRODAT,BWGRVIEN))
IF BWGRVIEN'=+BWGRVIEN
QUIT
IF $DATA(^BWPCD(BWGRVIEN,0))
DO PROC
+2 QUIT
PROC ;
+1 KILL BWGRSPEC,BWGRVREC,BWGRPREC,DFN
+2 IF BWGRPTVS="R"
SET BWGRVREC=^BWPCD(BWGRVIEN,0)
SET DFN=$PIECE(BWGRVREC,U,2)
+3 IF BWGRPTVS="P"
SET DFN=BWGRVIEN
SET BWGRVREC=""
+4 SET BWGRPREC=^BWP(DFN,0)
+5 DO SCREENS
+6 IF $DATA(BWGRSKIP)
QUIT
+7 KILL BWGRSRT,BWGRPRNT
SET BWGRCRIT=BWGRSORT
SET BWGRX=0
+8 IF $DATA(^BWGRI(BWGRSORT,4))
XECUTE ^BWGRI(BWGRSORT,4)
IF '$DATA(BWGRPRNT)
Begin DoDot:1
+9 IF BWGRPTVS="R"
SET Y=$PIECE($PIECE(BWGRVREC,U),".")
SET BWGRPRNT=Y
QUIT
+10 SET BWGRPRNT=$PIECE(^DPT(DFN,0),U)
+11 QUIT
End DoDot:1
+12 SET BWGRSRT=BWGRPRNT
+13 DO SUBPAT
+14 SET ^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"DATA HITS",BWGRSRT,BWGRVIEN)=""
SET BWGRRCNT=BWGRRCNT+1
+15 IF $DATA(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"PATIENTS",DFN))
QUIT
+16 SET ^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"PATIENTS",DFN)=""
SET BWGRPTCT=BWGRPTCT+1
+17 QUIT
SUBPAT ;tally # of patients by sort value on detailed/subtotal
+1 IF BWGRCTYP="C"
QUIT
+2 IF BWGRCTYP="F"
QUIT
+3 IF BWGRCTYP="T"
QUIT
+4 IF $GET(BWGRSRT)=""
SET BWGRSRT="????"
+5 IF $DATA(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PATIENT HIT",BWGRSRT,DFN))
QUIT
+6 IF '$DATA(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRT))
SET ^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRT)=0
+7 SET ^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRT)=^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRT)+1
+8 IF $DATA(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PATIENT HIT",BWGRSRT,DFN))
QUIT
+9 SET ^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PATIENT HIT",BWGRSRT,DFN)=""
+10 QUIT
SCREENS ;
+1 KILL BWGRSKIP
+2 SET BWGRI=0
FOR
SET BWGRI=$ORDER(^BWGRTRPT(BWGRRPT,11,BWGRI))
IF BWGRI'=+BWGRI!($DATA(BWGRSKIP))
QUIT
Begin DoDot:1
+3 IF '$PIECE(^BWGRI(BWGRI,0),U,8)
DO SINGLE
QUIT
+4 DO MULT
+5 QUIT
End DoDot:1
+6 QUIT
SINGLE ;
+1 KILL X,BWGRSPEC
SET X=""
SET BWGRX=0
+2 IF $DATA(^BWGRI(BWGRI,1))
XECUTE ^(1)
+3 IF X=""
SET BWGRSKIP=""
QUIT
+4 IF '$DATA(BWGRSPEC)
IF '$DATA(^BWGRTRPT(BWGRRPT,11,BWGRI,11,"B",X))
SET BWGRSKIP=""
QUIT
+5 QUIT
MULT ;
+1 KILL BWGRFOUN,BWGRSKIP,BWGRSPEC,X
SET BWGRX=0
SET X=""
+2 IF $DATA(^BWGRI(BWGRI,1))
XECUTE ^(1)
+3 IF $ORDER(X(""))=""
SET BWGRSKIP=""
QUIT
+4 IF '$DATA(BWGRSPEC)
SET Y=""
FOR
SET Y=$ORDER(X(Y))
IF Y=""
QUIT
IF $DATA(^BWGRTRPT(BWGRRPT,11,BWGRI,11,"B",Y))
SET BWGRFOUN=""
QUIT
+5 IF $DATA(BWGRSPEC)
IF $GET(X)
SET BWGRFOUN=1
QUIT
+6 IF '$DATA(BWGRFOUN)
SET BWGRSKIP=""
+7 QUIT
XIT ;EP - CALLED FROM BWGRVL
+1 DO EN^XBVK("BWGR")
DO EN^XBVK("AMQQ")
DO EN^XBVK("AUPN")
XIT1 ;EP
+1 KILL BWGRANS,BWGRBTH,BWGRC,BWGRCNT,BWGRCRIT,BWGRCUT,BWGRD,BWGRDISP,BWGRDONE,BWGRHIGH,BWGRI,BWGRJOB,BWGRQMAN,BWGRSEL,BWGRTEXT,BWGRVAR,BWGRSKIP,BWGRPRNT,BWGRPRNM,BWGRLINE,BWGRRCNT,BWGRSCNT,BWGRDFET,BWGRY,DFN
+2 KILL X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M,ZTIO,DUOUT,DIR,DTOUT,V,Z,I,DIC,DIK,DIADD,DLAYGO,DA,DR,DIE,DIU,AMQQTAX,DINUM,BWGRPACK,BWGREP1,BWGREP2,D,BWGRLENG,BWGRLHDR,BWGRSAVE,AMQQND
+3 QUIT
