DGPREP0 ;Boise/WRL/ALB/SCK-Program to Display Pre-Registration List ; 2/24/04 2:11pm
;;5.3;Registration;**109,546,586,581,1015**;Aug 13, 1993;Build 21
Q
;
EN ; -- main entry point
N VAUTD,X1
;
I '$D(^XUSEC("DGPRE EDIT",DUZ))&('$D(^XUSEC("DGPRE SUPV",DUZ))) D G ENQ
. W !!,"You do not have the requisite key allocated, contact your Supervisor."
; *** Select Divisions
I $P($G(^DG(43,1,"GL")),U,2) D
. D DIVISION^VAUTOMA
E D
. S DGSNGLDV=1
. S VAUTD=1
;
D EN^VALM("DGPRE RG")
ENQ Q
;
HDR ; -- header code
; Variables
; DGPSRT - Sort Method for call list display
;
N DGPSRT
I $D(VAUTD) S VALMHDR(1)="Call List sorted by Division and then "
S DGPSRT=$P($G(^DG(43,1,"DGPRE")),U)
S VALMHDR(1)=$G(VALMHDR(1))_"Sorted by "_$S(DGPSRT="P":"Patient Name",DGPSRT="S":"Medical Service")_"."
I $G(VAUTD) S VALMHDR(2)="All Divisions selected."
Q
;
INIT ; -- Retrieve data from call list and build TMP global for sorting Call lsit
; Variables
; DGPNR -
; DGPDATA - 0 Node from ^DGS(41.42,X
; DGPDATA1 - 1 Node from ^DGS(41.42,X
; DGPDIV - Division IEN from ^DGS(41.42,
; DGPDVN - Division Name
; DGPSV - Medical Service for appointment clinic
; DGPAT - Appt. date/time
; DGPPN - Patients name
; DGPNR - Index No. for LM
; DGPSRT - Call list sort method
; DGPN0,DGPN1,DGPNX - Local Var's for $O
;
N DGQ,DGPDATA,DGPDATA1,DGPDIV,DGPDVN,DGPNX,DGPN1,DGPN2
;
K ^TMP("DGPRERG",$J)
K ^TMP($J)
S DGPSRT=$P($G(^DG(43,1,"DGPRE")),U)
I $P($G(^DGS(41.42,0)),U,4)>1 W !!,"Sorting Entries..."
;
S DGPN1=0 F S DGPN1=$O(^DGS(41.42,DGPN1)) Q:'DGPN1 D
. S DGPDATA=$G(^DGS(41.42,DGPN1,0)),DGPDATA1=$G(^DGS(41.42,DGPN1,1))
. Q:DGPDATA']""!(DGPDATA1']"")
. ; **** Division handling
. S DGPDIV=$P(DGPDATA,U,2)
. I +DGPDIV'>0 D
.. I $G(DGSNGLDV) S DGPDIV=$S($D(^DG(40.8,1)):1,1:0) Q
.. S DGPDIV=-1
. K DGQ
. I '$G(DGSNGLDV) D Q:$G(DGQ)
.. I '$G(VAUTD),'$D(VAUTD(DGPDIV)) S DGQ=1
. ;
. S DGPSV=$P(DGPDATA1,U)
. S DGPAT=$P(DGPDATA,U,8)
. S DGPPN=$P(^DPT($P(^DGS(41.42,DGPN1,0),U),0),U)
. ;
. I DGPSRT="S" D
.. I DGPSV']"" W !,"NO SERVICE ENTRY FOR RECORD# ",DGPN1 Q
.. S ^TMP($J,DGPDIV,DGPSV,DGPN1)=$P(^DGS(41.42,DGPN1,0),U)
. ;
. I DGPSRT="P" D
.. I DGPPN']"" W !,"NO PATIENT ENTRY FOR RECORD# ",DGPN1 Q
.. S ^TMP($J,DGPDIV,DGPPN,DGPN1)=$P($G(^DGS(41.42,DGPN1,0)),U)
. ;
. I DGPSRT']"" D
.. I DGPPN']"" W !,"NO PATIENT ENTRY FOR RECORD# ",DGPN1 Q
.. S ^TMP($J,DGPDIV,DGPPN,DGPN1)=$P(^DGS(41.42,DGPN1,0),U)
. W "."
;
I $D(^TMP($J)) W !!,"Loading Sorted Entries into List..."
E D
. W *7,!!,"No appointments were found for the selected divisions"
. K DIR S DIR(0)="E" D ^DIR K DIR
;
; Retreive sorted call list form ^TMP and build LM arrays
;
S DGPNR=1
S DGPN0="" F S DGPN0=$O(^TMP($J,DGPN0)) Q:DGPN0="" D
. S DGPN1="" F S DGPN1=$O(^TMP($J,DGPN0,DGPN1)) Q:DGPN1="" D
.. S DGPNX="" F S DGPNX=$O(^TMP($J,DGPN0,DGPN1,DGPNX)) Q:DGPNX="" D
... S DGPDATA=$G(^DGS(41.42,DGPNX,0))
... S DGPDATA1=$G(^DGS(41.42,DGPNX,1))
... S DGPSV=$P(DGPDATA1,U)
... S X=$$SETFLD^VALM1(DGPNR,"","INDEX")
... S X=$$SETFLD^VALM1($E($P(^DPT($P(DGPDATA,U),0),U),1,30),X,"PATIENT")
... S DGPDFN=$P(DGPDATA,U)
... D BLDHIST
... S X=$$SETFLD^VALM1($P(DGPDATA1,U,2),X,"SSN")
... S X=$$SETFLD^VALM1(DGPSV,X,"SVC")
... S X=$$SETFLD^VALM1($E($P(DGPDATA1,U,3),1,18),X,"PHONE")
... S X=$$SETFLD^VALM1($$FMTE^XLFDT($P(DGPDATA,U,5),"2D"),X,"LAST")
... I $P(DGPDATA,U,6)="Y" D
.... ;S X=$$SETFLD^VALM1("*",X,"CALL")
... S DGPDVN=$S(+$G(DGPN0)>0:$P(^DG(40.8,DGPN0,0),U),DGPN0<0:"",1:DGPN0)
... S X=$$SETFLD^VALM1($E(DGPDVN,1,20),X,"DIVISION")
... S ^TMP("DGPRERG",$J,DGPNR,0)=X
... S ^TMP("DGPRERG",$J,"DA",DGPNR,DGPN1)=""
... S ^TMP("DGPRERG",$J,"DFN",DGPNR,DGPDFN)=""
... S ^TMP("DGPRERG",$J,"SSN",DGPNR,$P(DGPDATA1,U,2))=""
... S ^TMP("DGPRERG",$J,"IDX",DGPNR,DGPNR)=""
... S ^TMP("DGPRERG",$J,"DIV",DGPNR,DGPN0)=""
... S DGPNR=DGPNR+1
... W "."
S VALMCNT=DGPNR-1
I VALMCNT'>0 S VALMQUIT=1
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- Exit code
K ^TMP("DGPRERG",$J)
K DGPAT,DGPCH,DGPCL,DGPDA,DGPDATA,DGPDATA1,DGPDFN,DGPEDIT,DGPENT,DGPFLG,DGPIFN
K DGPLOC,DGPN0,DGPN1,DGPN2,DGPN3,DGPNR,DGPP1,DGPP2,DGPP3,DGPPN
K DGPPSRT,DGPST,DGPSV,DGPTAT,DA,X,Y,DIR,DIC,DIE
D FULL^VALM1
D CLEAN^VALM10
Q
;
BLDHIST ; Build history of call attempts from ^DGS(41.43, Call log
N DGPN2,DGPN3
;
S DGPN2=0 F S DGPN2=$O(^DGS(41.43,"C",DGPDFN,DGPN2)) Q:'DGPN2 D
. S:$P(^DGS(41.43,DGPN2,0),U,4)]"" ^TMP("STAT",$J,$P(^DGS(41.43,DGPN2,0),U,1))=$P(^DGS(41.43,DGPN2,0),U,4)
I $D(^TMP("STAT",$J)) D
. S DGPTAT=""
. S DGPN3=9999999.999999 F S DGPN3=$O(^TMP("STAT",$J,DGPN3),-1) Q:'DGPN3 D
.. S DGPTAT=DGPTAT_^TMP("STAT",$J,DGPN3)
. S X=$$SETFLD^VALM1(DGPTAT,X,"HIST")
. K ^TMP("STAT",$J)
Q
DGPREP0 ;Boise/WRL/ALB/SCK-Program to Display Pre-Registration List ; 2/24/04 2:11pm
+1 ;;5.3;Registration;**109,546,586,581,1015**;Aug 13, 1993;Build 21
+2 QUIT
+3 ;
EN ; -- main entry point
+1 NEW VAUTD,X1
+2 ;
+3 IF '$DATA(^XUSEC("DGPRE EDIT",DUZ))&('$DATA(^XUSEC("DGPRE SUPV",DUZ)))
Begin DoDot:1
+4 WRITE !!,"You do not have the requisite key allocated, contact your Supervisor."
End DoDot:1
GOTO ENQ
+5 ; *** Select Divisions
+6 IF $PIECE($GET(^DG(43,1,"GL")),U,2)
Begin DoDot:1
+7 DO DIVISION^VAUTOMA
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 SET DGSNGLDV=1
+10 SET VAUTD=1
End DoDot:1
+11 ;
+12 DO EN^VALM("DGPRE RG")
ENQ QUIT
+1 ;
HDR ; -- header code
+1 ; Variables
+2 ; DGPSRT - Sort Method for call list display
+3 ;
+4 NEW DGPSRT
+5 IF $DATA(VAUTD)
SET VALMHDR(1)="Call List sorted by Division and then "
+6 SET DGPSRT=$PIECE($GET(^DG(43,1,"DGPRE")),U)
+7 SET VALMHDR(1)=$GET(VALMHDR(1))_"Sorted by "_$SELECT(DGPSRT="P":"Patient Name",DGPSRT="S":"Medical Service")_"."
+8 IF $GET(VAUTD)
SET VALMHDR(2)="All Divisions selected."
+9 QUIT
+10 ;
INIT ; -- Retrieve data from call list and build TMP global for sorting Call lsit
+1 ; Variables
+2 ; DGPNR -
+3 ; DGPDATA - 0 Node from ^DGS(41.42,X
+4 ; DGPDATA1 - 1 Node from ^DGS(41.42,X
+5 ; DGPDIV - Division IEN from ^DGS(41.42,
+6 ; DGPDVN - Division Name
+7 ; DGPSV - Medical Service for appointment clinic
+8 ; DGPAT - Appt. date/time
+9 ; DGPPN - Patients name
+10 ; DGPNR - Index No. for LM
+11 ; DGPSRT - Call list sort method
+12 ; DGPN0,DGPN1,DGPNX - Local Var's for $O
+13 ;
+14 NEW DGQ,DGPDATA,DGPDATA1,DGPDIV,DGPDVN,DGPNX,DGPN1,DGPN2
+15 ;
+16 KILL ^TMP("DGPRERG",$JOB)
+17 KILL ^TMP($JOB)
+18 SET DGPSRT=$PIECE($GET(^DG(43,1,"DGPRE")),U)
+19 IF $PIECE($GET(^DGS(41.42,0)),U,4)>1
WRITE !!,"Sorting Entries..."
+20 ;
+21 SET DGPN1=0
FOR
SET DGPN1=$ORDER(^DGS(41.42,DGPN1))
IF 'DGPN1
QUIT
Begin DoDot:1
+22 SET DGPDATA=$GET(^DGS(41.42,DGPN1,0))
SET DGPDATA1=$GET(^DGS(41.42,DGPN1,1))
+23 IF DGPDATA']""!(DGPDATA1']"")
QUIT
+24 ; **** Division handling
+25 SET DGPDIV=$PIECE(DGPDATA,U,2)
+26 IF +DGPDIV'>0
Begin DoDot:2
+27 IF $GET(DGSNGLDV)
SET DGPDIV=$SELECT($DATA(^DG(40.8,1)):1,1:0)
QUIT
+28 SET DGPDIV=-1
End DoDot:2
+29 KILL DGQ
+30 IF '$GET(DGSNGLDV)
Begin DoDot:2
+31 IF '$GET(VAUTD)
IF '$DATA(VAUTD(DGPDIV))
SET DGQ=1
End DoDot:2
IF $GET(DGQ)
QUIT
+32 ;
+33 SET DGPSV=$PIECE(DGPDATA1,U)
+34 SET DGPAT=$PIECE(DGPDATA,U,8)
+35 SET DGPPN=$PIECE(^DPT($PIECE(^DGS(41.42,DGPN1,0),U),0),U)
+36 ;
+37 IF DGPSRT="S"
Begin DoDot:2
+38 IF DGPSV']""
WRITE !,"NO SERVICE ENTRY FOR RECORD# ",DGPN1
QUIT
+39 SET ^TMP($JOB,DGPDIV,DGPSV,DGPN1)=$PIECE(^DGS(41.42,DGPN1,0),U)
End DoDot:2
+40 ;
+41 IF DGPSRT="P"
Begin DoDot:2
+42 IF DGPPN']""
WRITE !,"NO PATIENT ENTRY FOR RECORD# ",DGPN1
QUIT
+43 SET ^TMP($JOB,DGPDIV,DGPPN,DGPN1)=$PIECE($GET(^DGS(41.42,DGPN1,0)),U)
End DoDot:2
+44 ;
+45 IF DGPSRT']""
Begin DoDot:2
+46 IF DGPPN']""
WRITE !,"NO PATIENT ENTRY FOR RECORD# ",DGPN1
QUIT
+47 SET ^TMP($JOB,DGPDIV,DGPPN,DGPN1)=$PIECE(^DGS(41.42,DGPN1,0),U)
End DoDot:2
+48 WRITE "."
End DoDot:1
+49 ;
+50 IF $DATA(^TMP($JOB))
WRITE !!,"Loading Sorted Entries into List..."
+51 IF '$TEST
Begin DoDot:1
+52 WRITE *7,!!,"No appointments were found for the selected divisions"
+53 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+54 ;
+55 ; Retreive sorted call list form ^TMP and build LM arrays
+56 ;
+57 SET DGPNR=1
+58 SET DGPN0=""
FOR
SET DGPN0=$ORDER(^TMP($JOB,DGPN0))
IF DGPN0=""
QUIT
Begin DoDot:1
+59 SET DGPN1=""
FOR
SET DGPN1=$ORDER(^TMP($JOB,DGPN0,DGPN1))
IF DGPN1=""
QUIT
Begin DoDot:2
+60 SET DGPNX=""
FOR
SET DGPNX=$ORDER(^TMP($JOB,DGPN0,DGPN1,DGPNX))
IF DGPNX=""
QUIT
Begin DoDot:3
+61 SET DGPDATA=$GET(^DGS(41.42,DGPNX,0))
+62 SET DGPDATA1=$GET(^DGS(41.42,DGPNX,1))
+63 SET DGPSV=$PIECE(DGPDATA1,U)
+64 SET X=$$SETFLD^VALM1(DGPNR,"","INDEX")
+65 SET X=$$SETFLD^VALM1($EXTRACT($PIECE(^DPT($PIECE(DGPDATA,U),0),U),1,30),X,"PATIENT")
+66 SET DGPDFN=$PIECE(DGPDATA,U)
+67 DO BLDHIST
+68 SET X=$$SETFLD^VALM1($PIECE(DGPDATA1,U,2),X,"SSN")
+69 SET X=$$SETFLD^VALM1(DGPSV,X,"SVC")
+70 SET X=$$SETFLD^VALM1($EXTRACT($PIECE(DGPDATA1,U,3),1,18),X,"PHONE")
+71 SET X=$$SETFLD^VALM1($$FMTE^XLFDT($PIECE(DGPDATA,U,5),"2D"),X,"LAST")
+72 IF $PIECE(DGPDATA,U,6)="Y"
Begin DoDot:4
+73 ;S X=$$SETFLD^VALM1("*",X,"CALL")
End DoDot:4
+74 SET DGPDVN=$SELECT(+$GET(DGPN0)>0:$PIECE(^DG(40.8,DGPN0,0),U),DGPN0<0:"",1:DGPN0)
+75 SET X=$$SETFLD^VALM1($EXTRACT(DGPDVN,1,20),X,"DIVISION")
+76 SET ^TMP("DGPRERG",$JOB,DGPNR,0)=X
+77 SET ^TMP("DGPRERG",$JOB,"DA",DGPNR,DGPN1)=""
+78 SET ^TMP("DGPRERG",$JOB,"DFN",DGPNR,DGPDFN)=""
+79 SET ^TMP("DGPRERG",$JOB,"SSN",DGPNR,$PIECE(DGPDATA1,U,2))=""
+80 SET ^TMP("DGPRERG",$JOB,"IDX",DGPNR,DGPNR)=""
+81 SET ^TMP("DGPRERG",$JOB,"DIV",DGPNR,DGPN0)=""
+82 SET DGPNR=DGPNR+1
+83 WRITE "."
End DoDot:3
End DoDot:2
End DoDot:1
+84 SET VALMCNT=DGPNR-1
+85 IF VALMCNT'>0
SET VALMQUIT=1
+86 QUIT
+87 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- Exit code
+1 KILL ^TMP("DGPRERG",$JOB)
+2 KILL DGPAT,DGPCH,DGPCL,DGPDA,DGPDATA,DGPDATA1,DGPDFN,DGPEDIT,DGPENT,DGPFLG,DGPIFN
+3 KILL DGPLOC,DGPN0,DGPN1,DGPN2,DGPN3,DGPNR,DGPP1,DGPP2,DGPP3,DGPPN
+4 KILL DGPPSRT,DGPST,DGPSV,DGPTAT,DA,X,Y,DIR,DIC,DIE
+5 DO FULL^VALM1
+6 DO CLEAN^VALM10
+7 QUIT
+8 ;
BLDHIST ; Build history of call attempts from ^DGS(41.43, Call log
+1 NEW DGPN2,DGPN3
+2 ;
+3 SET DGPN2=0
FOR
SET DGPN2=$ORDER(^DGS(41.43,"C",DGPDFN,DGPN2))
IF 'DGPN2
QUIT
Begin DoDot:1
+4 IF $PIECE(^DGS(41.43,DGPN2,0),U,4)]""
SET ^TMP("STAT",$JOB,$PIECE(^DGS(41.43,DGPN2,0),U,1))=$PIECE(^DGS(41.43,DGPN2,0),U,4)
End DoDot:1
+5 IF $DATA(^TMP("STAT",$JOB))
Begin DoDot:1
+6 SET DGPTAT=""
+7 SET DGPN3=9999999.999999
FOR
SET DGPN3=$ORDER(^TMP("STAT",$JOB,DGPN3),-1)
IF 'DGPN3
QUIT
Begin DoDot:2
+8 SET DGPTAT=DGPTAT_^TMP("STAT",$JOB,DGPN3)
End DoDot:2
+9 SET X=$$SETFLD^VALM1(DGPTAT,X,"HIST")
+10 KILL ^TMP("STAT",$JOB)
End DoDot:1
+11 QUIT
