DGPATN.m

DGPATN ;ALB/MRL - NEW PATIENT ENTRY ; 11/4/09 8:57pm

 ;;5.3;PIMS;**41,278,1007,1015,1016**;JUN 30, 2012;Build 20

 ;IHS/ANMC/LJF 8/25/2000 make sure DFN>0 in S subroutine

 ;IHS/OIT/LJF 4/4/2007 PATCH 1007 for merge project 

 ;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

 . Q:$G(XDRGID)  ;IHS/OIT/LJF 4/4/2007 skip if within patient merge

 . 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  ;IHS/ANMC/LJF 8/25/2000

 I $S('$G(DFN):1,'$D(X):1,1:0) Q  ;IHS/ANMC/LJF 8/25/2000

 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

DGPATN    ;ALB/MRL - NEW PATIENT ENTRY ; 11/4/09 8:57pm

 +1       ;;5.3;PIMS;**41,278,1007,1015,1016**;JUN 30, 2012;Build 20

 +2       ;IHS/ANMC/LJF 8/25/2000 make sure DFN>0 in S subroutine

 +3       ;IHS/OIT/LJF 4/4/2007 PATCH 1007 for merge project 

 +4       ;Name Changed/Patient Deleted Bulletin

 +5        IF $SELECT('$DATA(DFN):1,'$DATA(X):1,1:0)

               QUIT 

 +6       ; edit and edited to same value

           IF $DATA(DGNEWVAL)

               IF (DGNEWVAL=X)

                   QUIT 

 +7        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")

 +8       ;

 +9       ;Delete entries in PT/IHS file when entries deleted from PT file.

 +10       IF XMSUB="PATIENT DELETED"

               Begin DoDot:1

 +11      ;IHS/OIT/LJF 4/4/2007 skip if within patient merge

                   IF $GET(XDRGID)

                       QUIT 

 +12               NEW DA,DIK

 +13               SET DA=DFN

                   SET DIK="^AUPNPAT("

                   DO ^DIK

               End DoDot:1

 +14      ;

 +15       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_"'."

 +16       GOTO T

 +17      ;

S         ;SSN Changed/New Patient Added Bulletin

 +1       ;I $S('$D(DFN):1,'$D(X):1,1:0) Q  ;IHS/ANMC/LJF 8/25/2000

 +2       ;IHS/ANMC/LJF 8/25/2000

           IF $SELECT('$GET(DFN):1,'$DATA(X):1,1:0)

               QUIT 

 +3        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

 +4        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)

 +5        IF DGB=4

               SET DGTEXT(4,0)=""

               SET DGTEXT(5,0)="Previous SSN was '"_$PIECE(SSN,"^",2)_"'."

 +6       ;New patient Who & When

           IF DGB=2

               DO H^DGUTL

               Begin DoDot:1

 +7                NEW DGFDART

 +8                SET DGFDART(1,2,DFN_",",.097)=DGDATE

 +9                IF $GET(DUZ)

                       SET DGFDART(1,2,DFN_",",.096)=DUZ

 +10               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