DGPATN ;ALB/MRL - NEW PATIENT ENTRY ; 11/4/09 8:57pm
;;5.3;Registration;**41,278,671,820**;Aug 13, 1993;Build 5
;Name Changed/Patient Deleted Bulletin
I $S('$D(DFN):1,'$D(X):1,1:0) Q
I $D(DGNEWVAL),(DGNEWVAL=X) Q ; edit and edited to same value
S DGDATA=X D ^DGPATV S DGB=$S(DGNAME'=X:3,1:9) G Q:'DGB S XMSUB="PATIENT "_$S(DGB=3:"NAME CHANGED",1:"DELETED")
;
;Delete entries in PT/IHS file when entries deleted from PT file.
I XMSUB="PATIENT DELETED" D
. N DA,DIK
. S DA=DFN,DIK="^AUPNPAT(" D ^DIK
;
S DGTEXT(1,0)="NAME: "_DGNAME,DGTEXT(2,0)="SSN : "_$P(SSN,"^",2),DGTEXT(3,0)="DOB : "_$P(DOB,"^",2),DGTEXT(4,0)="" I DGB=3 S DGTEXT(5,0)="Previous name was '"_DGDATA_"'."
G T
;
S ;SSN Changed/New Patient Added Bulletin
I $S('$D(DFN):1,'$D(X):1,1:0) Q
S DGDATA=X D ^DGPATV S DGB=$S(SSN=X:2,SSN="UNSPECIFIED":2,DGDATA'=$P(SSN,"^",1):4,1:0) I 'DGB G Q
S XMSUB=$S(DGB=2:"NEW PATIENT ADDED TO SYSTEM",1:"SSN CHANGED"),DGTEXT(1,0)="NAME: "_DGNAME,DGTEXT(2,0)="SSN : "_$E(DGDATA,1,3)_"-"_$E(DGDATA,4,5)_"-"_$E(DGDATA,6,10),DGTEXT(3,0)="DOB : "_$P(DOB,"^",2)
I DGB=4 S DGTEXT(4,0)="",DGTEXT(5,0)="Previous SSN was '"_$P(SSN,"^",2)_"'."
I DGB=2 D H^DGUTL D ;New patient Who & When
.N DGFDART
.S DGFDART(1,2,DFN_",",.097)=DGDATE
.S:$G(DUZ) DGFDART(1,2,DFN_",",.096)=DUZ
.D UPDATE^DIE(,"DGFDART(1)")
T K XMTEXT D ^DGBUL
Q S X=DGDATA D KILL^DGPATV K DGDATA,DGTIME,DGDATE Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPATN 1424 printed Oct 16, 2024@18:47:50 Page 2
DGPATN ;ALB/MRL - NEW PATIENT ENTRY ; 11/4/09 8:57pm
+1 ;;5.3;Registration;**41,278,671,820**;Aug 13, 1993;Build 5
+2 ;Name Changed/Patient Deleted Bulletin
+3 IF $SELECT('$DATA(DFN):1,'$DATA(X):1,1:0)
QUIT
+4 ; edit and edited to same value
IF $DATA(DGNEWVAL)
IF (DGNEWVAL=X)
QUIT
+5 SET DGDATA=X
DO ^DGPATV
SET DGB=$SELECT(DGNAME'=X:3,1:9)
if 'DGB
GOTO Q
SET XMSUB="PATIENT "_$SELECT(DGB=3:"NAME CHANGED",1:"DELETED")
+6 ;
+7 ;Delete entries in PT/IHS file when entries deleted from PT file.
+8 IF XMSUB="PATIENT DELETED"
Begin DoDot:1
+9 NEW DA,DIK
+10 SET DA=DFN
SET DIK="^AUPNPAT("
DO ^DIK
End DoDot:1
+11 ;
+12 SET DGTEXT(1,0)="NAME: "_DGNAME
SET DGTEXT(2,0)="SSN : "_$PIECE(SSN,"^",2)
SET DGTEXT(3,0)="DOB : "_$PIECE(DOB,"^",2)
SET DGTEXT(4,0)=""
IF DGB=3
SET DGTEXT(5,0)="Previous name was '"_DGDATA_"'."
+13 GOTO T
+14 ;
S ;SSN Changed/New Patient Added Bulletin
+1 IF $SELECT('$DATA(DFN):1,'$DATA(X):1,1:0)
QUIT
+2 SET DGDATA=X
DO ^DGPATV
SET DGB=$SELECT(SSN=X:2,SSN="UNSPECIFIED":2,DGDATA'=$PIECE(SSN,"^",1):4,1:0)
IF 'DGB
GOTO Q
+3 SET XMSUB=$SELECT(DGB=2:"NEW PATIENT ADDED TO SYSTEM",1:"SSN CHANGED")
SET DGTEXT(1,0)="NAME: "_DGNAME
SET DGTEXT(2,0)="SSN : "_$EXTRACT(DGDATA,1,3)_"-"_$EXTRACT(DGDATA,4,5)_"-"_$EXTRACT(DGDATA,6,10)
SET DGTEXT(3,0)="DOB : "_$PIECE(DOB,"^",2)
+4 IF DGB=4
SET DGTEXT(4,0)=""
SET DGTEXT(5,0)="Previous SSN was '"_$PIECE(SSN,"^",2)_"'."
+5 ;New patient Who & When
IF DGB=2
DO H^DGUTL
Begin DoDot:1
+6 NEW DGFDART
+7 SET DGFDART(1,2,DFN_",",.097)=DGDATE
+8 if $GET(DUZ)
SET DGFDART(1,2,DFN_",",.096)=DUZ
+9 DO UPDATE^DIE(,"DGFDART(1)")
End DoDot:1
T KILL XMTEXT
DO ^DGBUL
Q SET X=DGDATA
DO KILL^DGPATV
KILL DGDATA,DGTIME,DGDATE
QUIT
