- DGPREP1 ;ALB/SCK,PWC - Program to Display Pre-Registration List Cont. 1 ;Jul 29, 2019@12:00
- ;;5.3;Registration;**109,136,574,903,980**;Aug 13, 1993;Build 4
- ;
- ; Subroutine DIREDT Linetag 26-29 added by patch DG*5.3*903 which was submitted to
- ; OSEHRA on 04/02/2015 by HP. This update was authored by James Harris 2014-2015
- ;
- Q
- EH ; Edit call log information
- ; Variables
- ; PTIFN - Patients IEN returned from 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,"
- . ;VSR (PWC) patch DG*5.3*980 change four slashes to three slashes for validation before filing except for DUZ
- . 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,DGMHVOUT,DGMHVNOS
- ;
- 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
- ;
- D
- .;These next 6 lines were added by patch DG*5.3*903
- .;This functionality will not be executed if "Enable MyHealtheVet Prompts?" (#1100.07
- .;field in MAS PARAMETERS (43) file is not set to YES (internal value 1)
- .Q:+$$MHVENABL^DGMHVUTL()'>0
- .N DGABB,DGMHVOUT,DIR
- .I '$$MHVOK^DGMHVAC(DFN) D EN^DGMHV(DFN) Q
- .D EN^DGMHVAC(DFN)
- ;
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPREP1 7316 printed Feb 19, 2025@00:17:06 Page 2
- DGPREP1 ;ALB/SCK,PWC - Program to Display Pre-Registration List Cont. 1 ;Jul 29, 2019@12:00
- +1 ;;5.3;Registration;**109,136,574,903,980**;Aug 13, 1993;Build 4
- +2 ;
- +3 ; Subroutine DIREDT Linetag 26-29 added by patch DG*5.3*903 which was submitted to
- +4 ; OSEHRA on 04/02/2015 by HP. This update was authored by James Harris 2014-2015
- +5 ;
- +6 QUIT
- EH ; Edit call log information
- +1 ; Variables
- +2 ; PTIFN - Patients IEN returned from 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 ;VSR (PWC) patch DG*5.3*980 change four slashes to three slashes for validation before filing except for DUZ
- +21 SET DR="1///^S X=DFN;2////^S X=DUZ;3///^S X=DGPS;5///^S X=$S(+DGPDV>0:DGPDV,1:"""")"
- +22 SET DA=+Y
- +23 DO ^DIE
- KILL DIE
- +24 IF $DATA(Y)
- Begin DoDot:2
- +25 SET DIK="^DGS(41.43,"
- DO ^DIK
- KILL DIK
- End DoDot:2
- End DoDot:1
- +26 QUIT +$GET(DA)
- +27 ;
- 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,DGMHVOUT,DGMHVNOS
- +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 Begin DoDot:1
- +27 ;These next 6 lines were added by patch DG*5.3*903
- +28 ;This functionality will not be executed if "Enable MyHealtheVet Prompts?" (#1100.07
- +29 ;field in MAS PARAMETERS (43) file is not set to YES (internal value 1)
- +30 if +$$MHVENABL^DGMHVUTL()'>0
- QUIT
- +31 NEW DGABB,DGMHVOUT,DIR
- +32 IF '$$MHVOK^DGMHVAC(DFN)
- DO EN^DGMHV(DFN)
- QUIT
- +33 DO EN^DGMHVAC(DFN)
- End DoDot:1
- +34 ;
- +35 SET DGNEW=0
- SET DGPFLG=1
- SET DGPSTMP=""
- SET DGMODE=1
- +36 ;
- +37 ; ** Since this is a direct call for a patient, and the particular appt. is not known, set DGPDIV to primary medical center division.
- +38 IF $GET(DGPDIV)']""
- Begin DoDot:1
- +39 SET DGPDIV=$$PRIM^VASITE
- End DoDot:1
- +40 ;
- +41 DO INITLE(.DGPSTMP)
- +42 ;
- +43 IF $GET(DGRPOUT)
- GOTO UNLCK
- +44 ;
- +45 IF $GET(DGPFLG)
- IF DGPIDX]""
- Begin DoDot:1
- +46 SET DA=DGPIDX
- +47 SET DIE="^DGS(41.42,"
- +48 SET DR="4///Y"
- IF DGPSTMP]""
- SET DR=DR_";3///^S X=DGPSTMP"
- +49 DO ^DIE
- KILL DIE
- End DoDot:1
- +50 ;
- UNLCK IF $GET(DGPIDX)]""
- LOCK -^DGS(41.42,DGPIDX)
- +1 QUIT