DGPREP1 ;ALB/SCK - Program to Display Pre-Registration List Cont. 1 ; 12/9/03 3:22pm
;;5.3;Registration;**109,136,574,1015**;Aug 13, 1993;Build 21
Q
EH ; Edit call log information
; Variables
; PTIFN - Patients IEN returned form the SELPAT procedure
;
N PTIFN,D,X,DA,DR
S PTIFN=""
D SELPAT
Q:'$D(PTIFN)
S DIC="^DGS(41.43,",DIC(0)="EQZ"
S X=PTIFN,D="C"
S DIC("A")="Select LOG ENTRY: "
S DIC("S")="I $P(^(0),U,2)=PTIFN"
;
D IX^DIC K DIC
;
I Y>0 D
. S DA=+Y
. S DIE="^DGS(41.43,"
. S DR="3;2///^S X=$P(^VA(200,DUZ,0),U)"
. D ^DIE K DIE
. I '$D(Y) D
.. S DGPDFN=PTIFN
.. D BLDHIST^DGPREP0
.. S X=$$SETSTR^VALM1(^TMP("DGPRERG",$J,DGPCH,0),"",1,110)
.. S X=$$SETFLD^VALM1(DGPTAT,X,"HIST")
.. S ^TMP("DGPRERG",$J,DGPCH,0)=X
S VALMBCK="R"
Q
;
SELPAT ; Select patient if no patient is passed in
N VALMI,VALMAT,VALMY,X
D FULL^VALM1
D EN^VALM2(XQORNOD(0),"S") S VALMI=0
I '$D(VALMY) S VALMBCK="R" Q
S DGPN1="",DGPCH=$O(VALMY(DGPN1))
S PTIFN="",PTIFN=$O(^TMP("DGPRERG",$J,"DFN",DGPCH,PTIFN))
Q
;
EDIT ; Edit Patient Information
; Variables
; DGPDIV - Division IEN from ^TMP
; DGPSTMP - Date/Time stamp from UPDLOG function
; DGPIFN - Patients IEN from ^TMP
; DGPP1-3,5 - Local Var's for $O
; DGPNEW -
; DGPFLG - Flag used to indicate a connect status of 'C'
; DGPST - Call status returned by SELST function
; DGPDA - IEN of Call log entry returned from UPDLOG function
; DGPCH - Entry in the VALMY, selected entries, array
;
N VALMI,VALMAT,VALMY,X,DGPN5,DGPDIV,DGPSTMP,DGPIFN,DGPP1,DGPP2,DGPP3,DGPNEW,DGPFLG
;
D FULL^VALM1
D EN^VALM2(XQORNOD(0),"S") S VALMI=0
I '$D(VALMY) S VALMBCK="R" Q
S DGPN1="",DGPCH=$O(VALMY(DGPN1))
S DGPIFN="",DGPIFN=$O(^TMP("DGPRERG",$J,"DFN",DGPCH,DGPIFN))
S DGPDIV="",DGPDIV=$O(^TMP("DGPRERG",$J,"DIV",DGPCH,DGPDIV))
S DGNEW=0,DGPFLG=0
;
; *** Check patient sensitivity before proceeding
S DIC=2,DIC(0)="ENQ",X=DGPIFN D ^DIC K DIC
Q:Y<0
;
; *** Check lock status before continuing
S DGPN5="",DGPN5=$O(^DGS(41.42,"B",DGPIFN,DGPN5))
I DGPN5]"" L +^DGS(41.42,DGPN5):2 I '$T W *7,!,"Another User is Editing this Patient" S VALMBCK="R" Q
;
S (DA,DFN)=DGPIFN
;
S DGPFLG=1
S DGPSTMP=""
D INITLE(.DGPSTMP)
;
I DGPCH]""&(DGPFLG) D
. S X=$$SETSTR^VALM1(^TMP("DGPRERG",$J,DGPCH,0),"",1,110)
. ;S X=$$SETSTR^VALM1("*",X,8,1)
. I $G(DGPSTMP)]"" S X=$$SETSTR^VALM1($$FMTE^XLFDT(DGPSTMP,"2D"),X,70,8)
. S ^TMP("DGPRERG",$J,DGPCH,0)=X
. S DIE="^DGS(41.42,",DA=DGPN5
. S DR="4///Y" I DGPSTMP]"" S DR=DR_";3///^S X=DGPSTMP"
. D ^DIE K DIE
L -^DGS(41.42,DGPN5)
K DGPENT,DGPN1,DGPCH,DGPLOC,DGPST,DGPN5,DGPFLG
Q
;
INITLE(DGPY) ; Initialize for Load/Edit
; Variables
; Input:
; DGPY - Null value
;
; Returns:
; DGPY - Returns the date/time stamp entered into ^DGS(41.41,.
;
; Local:
; DGPRFLG - This flag is used by the Patient Load/Edit routines
; to indicate they were called by preregistration
; DGPLOC - Flag used by DG10 to indicate preselection of a patient
;
N DGPRFLG
S (DGPRFLG,DGPLOC)=1
W !!
D ^DG10
Q:$G(DGPFLG)&($G(DGRPOUT))
;
S DGPST=$$SELST
I DGPST']"" S VALMBCK="R" Q
;
I DGPST'="L" D
. S DGPDA=$$UPDLOG(DGPIFN,DGPST,DGPDIV) Q:DGPDA'>0
. I '$G(DGMODE),$P($G(^DGS(41.43,DGPDA,0)),U,4)]"" D
.. S X=$$SETSTR^VALM1(^TMP("DGPRERG",$J,DGPCH,0),"",1,110)
.. S DGPP1=$E(X,1,34),DGPP2=$E(X,35,38),DGPP3=$E(X,39,110)
.. S DGPP2=$P(^DGS(41.43,DGPDA,0),U,4)_DGPP2
.. S X=DGPP1_$E(DGPP2,1,4)_DGPP3
.. S ^TMP("DGPRERG",$J,DGPCH,0)=X
;
W !
S DIR(0)="YA",DIR("A")="Date/Time stamp this patient? ",DIR("B")="YES"
D ^DIR K DIR
W !
I Y D
. K DD,DO
. S DGPY=$$NOW^XLFDT
. S DIC="^DGS(41.41,",DIC(0)="EQZ",X=DFN
. S DIC("DR")="1///^S X=DGPY;2////^S X=DUZ"
. D FILE^DICN
. K DIC
;
Q
STAT ; Display call history
K PTIFN D SELPAT
I $D(PTIFN) D
. D EN^DGPREP2
K PTIFN
Q
;
SELST() ; Function to select status for call log
; Returns:
; Status code as a SOC
;
K DIRUT
N DIR
W !!
S DIR(0)="41.43,3"
S DIR("A")="STATUS OF CALL",DIR("B")="CONNECTED"
S DIR("?",1)="Enter the status of the current call from the list below."
S DIR("?")="Entries must be in uppercase, and match on of these codes."
D ^DIR K DIR
Q $G(Y)
;
UPDLOG(DFN,DGPS,DGPDV) ; Update PRE-REGISTRATION CALL LOG File, #41.43
;
; Variables
; Input:
; DFN - The IEN of the patient being called
; DGPS - Status of the call attempt
; DGPDV - Division IEN (used for sorting)
;
; Returns:
; The IEN of the CALL LOG, File #41.43, entry that was added.
; 0 is returned if the user ^'s out.
;
K DD,DO
S DIC="^DGS(41.43,"
S DIC(0)="L"
S X=$$NOW^XLFDT
D FILE^DICN
I Y<0 W *7,"Problem adding to file - PRE-REGISTRATION CALL LOG"
I Y'<0 D
. S DIE="^DGS(41.43,"
. S DR="1////^S X=DFN;2////^S X=DUZ;3///^S X=DGPS;5////^S X=$S(+DGPDV>0:DGPDV,1:"""")"
. S DA=+Y
. D ^DIE K DIE
. I $D(Y) D
.. S DIK="^DGS(41.43," D ^DIK K DIK
Q +$G(DA)
;
DIREDT ; Direct edit of a patient in the PRE-REGISTRATION CALL LIST, bypassing the call list.
;
; Variables
; DFN - Patients IEN, set for Load/Edit
; DGPDIV - Division IEN from File #41.42
; DGPST - Call Status
; DGPIDX - Call List IEN, File #41.42
; DGPFLG - Flag for direct patient edit, used for setting 'called' status
; DGPSTMP - Date/time stamp
;
N DFN,DGPDIV,DGPST,DGPIDX,DGPFLG,DGNEW,DGPXX,DGPSTMP,DGPX,DGPIFN,DGMODE
N DGRPOUT
;
K DTOUT,DUOUT,DIC
S DIC=2,DIC(0)="AEQZM"
S DIC("A")="Select Patient to Preregister: "
S DIC("?")="Select a patient whose preregistration information you want to edit."
D ^DIC K DIC
I $D(DTOUT)!($D(DUOUT))!(Y<0) Q
;
S (DFN,DGPIFN)=+Y,DGPIDX=""
I $D(^DGS(41.42,"B",DFN)) D Q:$G(DGPX)
. S DGPIDX=$O(^DGS(41.42,"B",DFN,DGPIDX))
. S DGPDIV=$P($G(^DGS(41.42,DGPIDX,0)),U,2)
. I DGPIDX]"" L +^DGS(41.42,DGPIDX):2 I '$T W *7,!,"Another user is editing this patient." S DGPX=1
;
S DGNEW=0,DGPFLG=1,DGPSTMP="",DGMODE=1
;
; ** Since this is a direct call for a patient, and the particular appt. is not known, set DGPDIV to primary medical center division.
I $G(DGPDIV)']"" D
. S DGPDIV=$$PRIM^VASITE
;
D INITLE(.DGPSTMP)
;
I $G(DGRPOUT) G UNLCK
;
I $G(DGPFLG),DGPIDX]"" D
. S DA=DGPIDX
. S DIE="^DGS(41.42,"
. S DR="4///Y" I DGPSTMP]"" S DR=DR_";3///^S X=DGPSTMP"
. D ^DIE K DIE
;
UNLCK I $G(DGPIDX)]"" L -^DGS(41.42,DGPIDX)
Q
DGPREP1 ;ALB/SCK - Program to Display Pre-Registration List Cont. 1 ; 12/9/03 3:22pm
+1 ;;5.3;Registration;**109,136,574,1015**;Aug 13, 1993;Build 21
+2 QUIT
EH ; Edit call log information
+1 ; Variables
+2 ; PTIFN - Patients IEN returned form the SELPAT procedure
+3 ;
+4 NEW PTIFN,D,X,DA,DR
+5 SET PTIFN=""
+6 DO SELPAT
+7 IF '$DATA(PTIFN)
QUIT
+8 SET DIC="^DGS(41.43,"
SET DIC(0)="EQZ"
+9 SET X=PTIFN
SET D="C"
+10 SET DIC("A")="Select LOG ENTRY: "
+11 SET DIC("S")="I $P(^(0),U,2)=PTIFN"
+12 ;
+13 DO IX^DIC
KILL DIC
+14 ;
+15 IF Y>0
Begin DoDot:1
+16 SET DA=+Y
+17 SET DIE="^DGS(41.43,"
+18 SET DR="3;2///^S X=$P(^VA(200,DUZ,0),U)"
+19 DO ^DIE
KILL DIE
+20 IF '$DATA(Y)
Begin DoDot:2
+21 SET DGPDFN=PTIFN
+22 DO BLDHIST^DGPREP0
+23 SET X=$$SETSTR^VALM1(^TMP("DGPRERG",$JOB,DGPCH,0),"",1,110)
+24 SET X=$$SETFLD^VALM1(DGPTAT,X,"HIST")
+25 SET ^TMP("DGPRERG",$JOB,DGPCH,0)=X
End DoDot:2
End DoDot:1
+26 SET VALMBCK="R"
+27 QUIT
+28 ;
SELPAT ; Select patient if no patient is passed in
+1 NEW VALMI,VALMAT,VALMY,X
+2 DO FULL^VALM1
+3 DO EN^VALM2(XQORNOD(0),"S")
SET VALMI=0
+4 IF '$DATA(VALMY)
SET VALMBCK="R"
QUIT
+5 SET DGPN1=""
SET DGPCH=$ORDER(VALMY(DGPN1))
+6 SET PTIFN=""
SET PTIFN=$ORDER(^TMP("DGPRERG",$JOB,"DFN",DGPCH,PTIFN))
+7 QUIT
+8 ;
EDIT ; Edit Patient Information
+1 ; Variables
+2 ; DGPDIV - Division IEN from ^TMP
+3 ; DGPSTMP - Date/Time stamp from UPDLOG function
+4 ; DGPIFN - Patients IEN from ^TMP
+5 ; DGPP1-3,5 - Local Var's for $O
+6 ; DGPNEW -
+7 ; DGPFLG - Flag used to indicate a connect status of 'C'
+8 ; DGPST - Call status returned by SELST function
+9 ; DGPDA - IEN of Call log entry returned from UPDLOG function
+10 ; DGPCH - Entry in the VALMY, selected entries, array
+11 ;
+12 NEW VALMI,VALMAT,VALMY,X,DGPN5,DGPDIV,DGPSTMP,DGPIFN,DGPP1,DGPP2,DGPP3,DGPNEW,DGPFLG
+13 ;
+14 DO FULL^VALM1
+15 DO EN^VALM2(XQORNOD(0),"S")
SET VALMI=0
+16 IF '$DATA(VALMY)
SET VALMBCK="R"
QUIT
+17 SET DGPN1=""
SET DGPCH=$ORDER(VALMY(DGPN1))
+18 SET DGPIFN=""
SET DGPIFN=$ORDER(^TMP("DGPRERG",$JOB,"DFN",DGPCH,DGPIFN))
+19 SET DGPDIV=""
SET DGPDIV=$ORDER(^TMP("DGPRERG",$JOB,"DIV",DGPCH,DGPDIV))
+20 SET DGNEW=0
SET DGPFLG=0
+21 ;
+22 ; *** Check patient sensitivity before proceeding
+23 SET DIC=2
SET DIC(0)="ENQ"
SET X=DGPIFN
DO ^DIC
KILL DIC
+24 IF Y<0
QUIT
+25 ;
+26 ; *** Check lock status before continuing
+27 SET DGPN5=""
SET DGPN5=$ORDER(^DGS(41.42,"B",DGPIFN,DGPN5))
+28 IF DGPN5]""
LOCK +^DGS(41.42,DGPN5):2
IF '$TEST
WRITE *7,!,"Another User is Editing this Patient"
SET VALMBCK="R"
QUIT
+29 ;
+30 SET (DA,DFN)=DGPIFN
+31 ;
+32 SET DGPFLG=1
+33 SET DGPSTMP=""
+34 DO INITLE(.DGPSTMP)
+35 ;
+36 IF DGPCH]""&(DGPFLG)
Begin DoDot:1
+37 SET X=$$SETSTR^VALM1(^TMP("DGPRERG",$JOB,DGPCH,0),"",1,110)
+38 ;S X=$$SETSTR^VALM1("*",X,8,1)
+39 IF $GET(DGPSTMP)]""
SET X=$$SETSTR^VALM1($$FMTE^XLFDT(DGPSTMP,"2D"),X,70,8)
+40 SET ^TMP("DGPRERG",$JOB,DGPCH,0)=X
+41 SET DIE="^DGS(41.42,"
SET DA=DGPN5
+42 SET DR="4///Y"
IF DGPSTMP]""
SET DR=DR_";3///^S X=DGPSTMP"
+43 DO ^DIE
KILL DIE
End DoDot:1
+44 LOCK -^DGS(41.42,DGPN5)
+45 KILL DGPENT,DGPN1,DGPCH,DGPLOC,DGPST,DGPN5,DGPFLG
+46 QUIT
+47 ;
INITLE(DGPY) ; Initialize for Load/Edit
+1 ; Variables
+2 ; Input:
+3 ; DGPY - Null value
+4 ;
+5 ; Returns:
+6 ; DGPY - Returns the date/time stamp entered into ^DGS(41.41,.
+7 ;
+8 ; Local:
+9 ; DGPRFLG - This flag is used by the Patient Load/Edit routines
+10 ; to indicate they were called by preregistration
+11 ; DGPLOC - Flag used by DG10 to indicate preselection of a patient
+12 ;
+13 NEW DGPRFLG
+14 SET (DGPRFLG,DGPLOC)=1
+15 WRITE !!
+16 DO ^DG10
+17 IF $GET(DGPFLG)&($GET(DGRPOUT))
QUIT
+18 ;
+19 SET DGPST=$$SELST
+20 IF DGPST']""
SET VALMBCK="R"
QUIT
+21 ;
+22 IF DGPST'="L"
Begin DoDot:1
+23 SET DGPDA=$$UPDLOG(DGPIFN,DGPST,DGPDIV)
IF DGPDA'>0
QUIT
+24 IF '$GET(DGMODE)
IF $PIECE($GET(^DGS(41.43,DGPDA,0)),U,4)]""
Begin DoDot:2
+25 SET X=$$SETSTR^VALM1(^TMP("DGPRERG",$JOB,DGPCH,0),"",1,110)
+26 SET DGPP1=$EXTRACT(X,1,34)
SET DGPP2=$EXTRACT(X,35,38)
SET DGPP3=$EXTRACT(X,39,110)
+27 SET DGPP2=$PIECE(^DGS(41.43,DGPDA,0),U,4)_DGPP2
+28 SET X=DGPP1_$EXTRACT(DGPP2,1,4)_DGPP3
+29 SET ^TMP("DGPRERG",$JOB,DGPCH,0)=X
End DoDot:2
End DoDot:1
+30 ;
+31 WRITE !
+32 SET DIR(0)="YA"
SET DIR("A")="Date/Time stamp this patient? "
SET DIR("B")="YES"
+33 DO ^DIR
KILL DIR
+34 WRITE !
+35 IF Y
Begin DoDot:1
+36 KILL DD,DO
+37 SET DGPY=$$NOW^XLFDT
+38 SET DIC="^DGS(41.41,"
SET DIC(0)="EQZ"
SET X=DFN
+39 SET DIC("DR")="1///^S X=DGPY;2////^S X=DUZ"
+40 DO FILE^DICN
+41 KILL DIC
End DoDot:1
+42 ;
+43 QUIT
STAT ; Display call history
+1 KILL PTIFN
DO SELPAT
+2 IF $DATA(PTIFN)
Begin DoDot:1
+3 DO EN^DGPREP2
End DoDot:1
+4 KILL PTIFN
+5 QUIT
+6 ;
SELST() ; Function to select status for call log
+1 ; Returns:
+2 ; Status code as a SOC
+3 ;
+4 KILL DIRUT
+5 NEW DIR
+6 WRITE !!
+7 SET DIR(0)="41.43,3"
+8 SET DIR("A")="STATUS OF CALL"
SET DIR("B")="CONNECTED"
+9 SET DIR("?",1)="Enter the status of the current call from the list below."
+10 SET DIR("?")="Entries must be in uppercase, and match on of these codes."
+11 DO ^DIR
KILL DIR
+12 QUIT $GET(Y)
+13 ;
UPDLOG(DFN,DGPS,DGPDV) ; Update PRE-REGISTRATION CALL LOG File, #41.43
+1 ;
+2 ; Variables
+3 ; Input:
+4 ; DFN - The IEN of the patient being called
+5 ; DGPS - Status of the call attempt
+6 ; DGPDV - Division IEN (used for sorting)
+7 ;
+8 ; Returns:
+9 ; The IEN of the CALL LOG, File #41.43, entry that was added.
+10 ; 0 is returned if the user ^'s out.
+11 ;
+12 KILL DD,DO
+13 SET DIC="^DGS(41.43,"
+14 SET DIC(0)="L"
+15 SET X=$$NOW^XLFDT
+16 DO FILE^DICN
+17 IF Y<0
WRITE *7,"Problem adding to file - PRE-REGISTRATION CALL LOG"
+18 IF Y'<0
Begin DoDot:1
+19 SET DIE="^DGS(41.43,"
+20 SET DR="1////^S X=DFN;2////^S X=DUZ;3///^S X=DGPS;5////^S X=$S(+DGPDV>0:DGPDV,1:"""")"
+21 SET DA=+Y
+22 DO ^DIE
KILL DIE
+23 IF $DATA(Y)
Begin DoDot:2
+24 SET DIK="^DGS(41.43,"
DO ^DIK
KILL DIK
End DoDot:2
End DoDot:1
+25 QUIT +$GET(DA)
+26 ;
DIREDT ; Direct edit of a patient in the PRE-REGISTRATION CALL LIST, bypassing the call list.
+1 ;
+2 ; Variables
+3 ; DFN - Patients IEN, set for Load/Edit
+4 ; DGPDIV - Division IEN from File #41.42
+5 ; DGPST - Call Status
+6 ; DGPIDX - Call List IEN, File #41.42
+7 ; DGPFLG - Flag for direct patient edit, used for setting 'called' status
+8 ; DGPSTMP - Date/time stamp
+9 ;
+10 NEW DFN,DGPDIV,DGPST,DGPIDX,DGPFLG,DGNEW,DGPXX,DGPSTMP,DGPX,DGPIFN,DGMODE
+11 NEW DGRPOUT
+12 ;
+13 KILL DTOUT,DUOUT,DIC
+14 SET DIC=2
SET DIC(0)="AEQZM"
+15 SET DIC("A")="Select Patient to Preregister: "
+16 SET DIC("?")="Select a patient whose preregistration information you want to edit."
+17 DO ^DIC
KILL DIC
+18 IF $DATA(DTOUT)!($DATA(DUOUT))!(Y<0)
QUIT
+19 ;
+20 SET (DFN,DGPIFN)=+Y
SET DGPIDX=""
+21 IF $DATA(^DGS(41.42,"B",DFN))
Begin DoDot:1
+22 SET DGPIDX=$ORDER(^DGS(41.42,"B",DFN,DGPIDX))
+23 SET DGPDIV=$PIECE($GET(^DGS(41.42,DGPIDX,0)),U,2)
+24 IF DGPIDX]""
LOCK +^DGS(41.42,DGPIDX):2
IF '$TEST
WRITE *7,!,"Another user is editing this patient."
SET DGPX=1
End DoDot:1
IF $GET(DGPX)
QUIT
+25 ;
+26 SET DGNEW=0
SET DGPFLG=1
SET DGPSTMP=""
SET DGMODE=1
+27 ;
+28 ; ** Since this is a direct call for a patient, and the particular appt. is not known, set DGPDIV to primary medical center division.
+29 IF $GET(DGPDIV)']""
Begin DoDot:1
+30 SET DGPDIV=$$PRIM^VASITE
End DoDot:1
+31 ;
+32 DO INITLE(.DGPSTMP)
+33 ;
+34 IF $GET(DGRPOUT)
GOTO UNLCK
+35 ;
+36 IF $GET(DGPFLG)
IF DGPIDX]""
Begin DoDot:1
+37 SET DA=DGPIDX
+38 SET DIE="^DGS(41.42,"
+39 SET DR="4///Y"
IF DGPSTMP]""
SET DR=DR_";3///^S X=DGPSTMP"
+40 DO ^DIE
KILL DIE
End DoDot:1
+41 ;
UNLCK IF $GET(DGPIDX)]""
LOCK -^DGS(41.42,DGPIDX)
+1 QUIT
