Changeset 636 for FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGREG.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGREG.m
r628 r636 1 DGREG ;ALB/JDS,MRL/PJR/PHH-REGISTER PATIENT ; 8/24/05 1:40pm 2 ;;5.3;Registration;**1,32,108,147,149,182,245,250,513,425,533,574,563,624,658**;Aug 13, 1993 1 DGREG ;ALB/JDS,MRL/PJR/PHH-REGISTER PATIENT ;1/27/07 13:08 2 ;;5.3;Registration;**1,32,108,147,149,182,245,250,513,425,533,574,563,624,658,634**;Aug 13, 1993;Build 28 3 ; Modified from FOIA VISTA, 4 ; Copyright (C) 2007 WorldVistA 5 ; 6 ; This program is free software; you can redistribute it and/or modify 7 ; it under the terms of the GNU General Public License as published by 8 ; the Free Software Foundation; either version 2 of the License, or 9 ; (at your option) any later version. 10 ; 3 11 START ; 4 12 EN D LO^DGUTL S DGCLPR="" … … 10 18 I '$D(DGIO),$P(^DG(43,1,0),U,30) S %ZIS="N",IOP="HOME" D ^%ZIS I $D(IOS),IOS,$D(^%ZIS(1,+IOS,99)),$D(^%ZIS(1,+^(99),0)) S Y=$P(^(0),U,1) W !,"Using closest printer ",Y,! F I=10,"PRF","RT","HS" S DGIO(I)=Y 11 19 A D ENDREG($G(DFN)) 12 W !! S DIC=2,DIC(0)="ALEQM",DLAYGO=2 K DIC("S"),DIC("B") D ^DIC K DLAYGO G Q1:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) N Y D PAUSE^DG10 D BEGINREG(DFN) I DGNEW D NEW^DGRP 20 ; 21 ; ** VOE change 1 of 4: DAOU/WCJ 2/1/2005,VA/CJS,WV/TOAD 1/5/2006 ** 22 ; 23 ; if not VA agency code, add DIC("DR") to default some identifiers and 24 ; skip others also, improve readability 25 ; 26 ; before change: 27 ; W !! S DIC=2,DIC(0)="ALEQM",DLAYGO=2 K DIC("S"),DIC("B") D ^DIC K DLAYGO G Q1:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) N Y D PAUSE^DG10 D BEGINREG(DFN) I DGNEW D NEW^DGRP 28 ; 29 ; after change: 30 W !! 31 N Y,DGREGY S DGREGY=1 D I DGREGY<0 G Q1 32 . N DIC S DIC=2 ; Patient file 33 . S DIC(0)="ALEQM" ; ask, laygo, echo, question, and multi-index 34 . N DLAYGO S DLAYGO=2 ; override file access by user: allow laygo 35 . I $G(DUZ("AG"))'="V" D ;adjust identifiers asked for VOE 36 . . S DIC("DR")=".02;.03;994;.301///N;391///VISTA OFFICE EHR;1901///N;.09" 37 . ; 38 . D ^DIC ; Select Patient 39 . ; 40 . I Y<0 S DGREGY=-1 Q 41 . K DIC("DR") 42 . S (DFN,DA)=+Y 43 . S DGNEW=$P(Y,"^",3) ; new patient? 44 . N Y D PAUSE^DG10 ; prompt user before continuing 45 . D BEGINREG(DFN) ; lock patient record 46 ; 47 ; ** end of VOE change 1 ** 13 48 ; 14 49 ;; ask to continue if patient died - DG*5.3*563 - pjr 10/12/04 … … 18 53 D CIRN 19 54 ; 20 I +$G(DGNEW) D 55 ; ** VOE change 2 of 4: DAOU/WCJ 2/1/2005,VA/CJS,WV/TOAD 1/5/2006 ** 56 ; 57 I $G(DGNEW) D NEW^DGRP ; execute new patient DR string 58 ; 59 ; send CMOR query and display results only if VA agency code 60 ; 61 ; before change: 62 ; I +$G(DGNEW) D 63 ; 64 ; after change: 65 I $G(DGNEW),$G(DUZ("AG"))="V" D 66 . ; 67 . ; end of change 68 . ; 21 69 . ; query CMOR for Patient Record Flag Assignments if NEW patient and 22 70 . ; display results. 23 71 . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN) 24 72 ; 25 D ROMQRY 73 ; before change: 74 ; D ROMQRY 75 ; 76 ; after change: 77 I $G(DUZ("AG"))="V" D ROMQRY 78 ; 79 ; ** end of VOE change 2 ** 26 80 ; 27 81 S (DGFC,CURR)=0 … … 30 84 D HINQ^DG10 31 85 I $D(^DIC(195.4,1,"UP")) I ^("UP") D ADM^RTQ3 32 D REG^IVMCQ($G(DFN)) ; send financial query 86 ; 87 ; ** VOE change 3 of 4: DAOU/WCJ 2/1/2005,VA/CJS,WV/TOAD 1/5/2006 ** 88 ; 89 ; send financial query only for VA agency code 90 ; 91 ; before change: 92 ; D REG^IVMCQ($G(DFN)) ; send financial query 93 ; 94 ; after change: 95 I $G(DUZ("AG"))="V" D REG^IVMCQ($G(DFN)) ; send financial query 96 ; 97 ; ** end of VOE change 3 ** 98 ; 33 99 G A1 34 100 ; … … 62 128 ; 63 129 S DA=DFN1,DIE("NO^")="",DA(1)=DFN,DP=2.101,DR="1///"_$S(SEEN=2:2,CURR=1:1,1:0)_";Q;2"_$S(CURR=1:"///3",1:"")_";2.1;3//"_$S($P(^DG(43,1,"GL"),"^",2):"",1:"/")_$S($D(^DG(40.8,+$P(^DG(43,1,"GL"),"^",3),0)):$P(^(0),"^",1),1:"")_";4////"_DUZ 130 ; 131 ; ** VOE change 4 of 4: DAOU/JLG 2/7/2005,VA/CJS,WV/TOAD 1/5/2006 ** 132 ; 133 ; for VOE or IHS agency codes, add the following: 134 ; force TYPE OF CARE with ALL OTHER 135 ; 136 I $G(DUZ("AG"))="E"!($G(DUZ("AG"))="I") D 137 . S DR="1///"_$S(SEEN=2:2,CURR=1:1,1:0)_";Q;2"_$S(CURR=1:"///3",1:"")_";2.1///5;3//"_$S($P(^DG(43,1,"GL"),"^",2):"",1:"/")_$S($D(^DG(40.8,+$P(^DG(43,1,"GL"),"^",3),0)):$P(^(0),"^",1),1:"")_";4////"_DUZ 138 ; 139 ; ** end of VOE change 4 ** 140 ; 64 141 D EL K DIC("A") N DGNDLOCK S DGNDLOCK=DIE_DFN1_")" L +@DGNDLOCK:2 G:'$T MSG D ^DIE L -@DGNDLOCK 65 142 I $D(DTOUT) D G Q
Note:
See TracChangeset
for help on using the changeset viewer.