DGHNYXFR.m

DGHNYXFR ; IHS/ADC/PDW/ENM - HONEYWELL TRANSFER ROUTINE 15:19 ;  [ 03/25/1999  11:48 AM ]

 ;;5.3;Registration;**1015**;MAR 25, 1999;Build 21

 ;;MAS VERSION 5.0;

 ;

EN Q  ;will be obsolete with v5

 S H=$P($H,",",2),H=DT+(H\3600/100)+(H\60#60/10000),P=$S($D(^DPT(DFN,0)):^(0),1:"") Q:P=""

LOCK L ^HNY(43.2,H):1 I '$T!$D(^HNY(43.2,H)) L  S H=H+.00001 G LOCK

 S (R,^HNY(43.2,H,0))=$P(P,"^",1)_"^"_$P(P,"^",9),^(1)=H_"^"_DUZ,^HNY(43.2,"B",$P(P,"^",1),H)="",^HNY(43.2,"C",H,H)="",^(0)=$P(^HNY(43.2,0),"^",1,2)_"^"_H_"^"_($P(^(0),"^",4)+1),^DISV(DUZ,"^HNY(43.2,")=H L

 D @DGHNYT K DGHNYT,DGHNOSSN Q

1 ; NEW REGISTRATION

 S ^HNY(43.2,H,0)=R_"^^^^1" Q

2 ; ADMISSION

 S A=^DPT(DFN,"DA",DA,0),W=$S($D(^DIC(42,+$P(A,"^",4),0)):$P(^(0),"^",1),1:""),^HNY(43.2,H,0)=R_"^"_W_"^"_$P(A,"^",10)_"^1^2" Q

3 ; TRANSFER

 S T=$S($D(^DPT(DFN,"DA",DFN1,2,DFN2,0)):^(0),1:"") Q:'T  S W=$S($D(^DIC(42,+$P(T,"^",4),0)):$P(^(0),"^",1),1:""),B='(DGTY=1!(DGTY=2)!(DGTY=3))

 S:W="" W=$S($D(^DPT(DFN,.1)):^(.1),1:"") S ^HNY(43.2,H,0)=R_"^"_W_"^"_$P(T,"^",10)_"^"_B_"^3" Q

4 ; DISCHARGE

 S ^HNY(43.2,H,0)=R_"^^^^4" Q

5 ; CLINIC DISCHARGE

 S ^HNY(43.2,H,0)=R_"^^^^5" Q

6 ; NAME CHANGE

 K ^HNY(43.2,"B",$P(R,"^",1),H) S ^HNY(43.2,H,0)=X_"^"_$P(R,"^",2)_"^^^^6^^"_$P(R,"^",1),^HNY(43.2,"B",X,H)="" Q

7 ; SSN CHANGE

 S ^HNY(43.2,H,0)=$P(R,"^",1)_"^"_DGHNOSSN_"^^^^7^"_$P(R,"^",2) Q

8 ; BED CHANGE

 S ^HNY(43.2,H,0)=R_"^"_$S($D(^DPT(DFN,.1)):^(.1),1:"")_"^"_$S($D(^(.101)):^(.101),1:"")_"^1^8" Q

9 ; DELETED ADMISSION

 S ^HNY(43.2,H,0)=R_"^^^^9" Q

10 ; DELETED DISCHARGE

 S ^HNY(43.2,H,0)=R_"^"_$S($D(^DPT(DFN,.1)):^(.1),1:"")_"^"_$S($D(^(.101)):^(.101),1:"")_"^1^10" Q

DGHNYXFR  ; IHS/ADC/PDW/ENM - HONEYWELL TRANSFER ROUTINE 15:19 ;  [ 03/25/1999  11:48 AM ]

 +1       ;;5.3;Registration;**1015**;MAR 25, 1999;Build 21

 +2       ;;MAS VERSION 5.0;

 +3       ;

EN        ;will be obsolete with v5

           QUIT 

 +1        SET H=$PIECE($HOROLOG,",",2)

           SET H=DT+(H\3600/100)+(H\60#60/10000)

           SET P=$SELECT($DATA(^DPT(DFN,0)):^(0),1:"")

           IF P=""

               QUIT 

LOCK       LOCK ^HNY(43.2,H):1

           IF '$TEST!$DATA(^HNY(43.2,H))

               LOCK 

               SET H=H+.00001

               GOTO LOCK

 +1        SET (R,^HNY(43.2,H,0))=$PIECE(P,"^",1)_"^"_$PIECE(P,"^",9)

           SET ^(1)=H_"^"_DUZ

           SET ^HNY(43.2,"B",$PIECE(P,"^",1),H)=""

           SET ^HNY(43.2,"C",H,H)=""

           SET ^(0)=$PIECE(^HNY(43.2,0),"^",1,2)_"^"_H_"^"_($PIECE(^(0),"^",4)+1)

           SET ^DISV(DUZ,"^HNY(43.2,")=H

           LOCK 

 +2        DO @DGHNYT

           KILL DGHNYT,DGHNOSSN

           QUIT 

1         ; NEW REGISTRATION

 +1        SET ^HNY(43.2,H,0)=R_"^^^^1"

           QUIT 

2         ; ADMISSION

 +1        SET A=^DPT(DFN,"DA",DA,0)

           SET W=$SELECT($DATA(^DIC(42,+$PIECE(A,"^",4),0)):$PIECE(^(0),"^",1),1:"")

           SET ^HNY(43.2,H,0)=R_"^"_W_"^"_$PIECE(A,"^",10)_"^1^2"

           QUIT 

3         ; TRANSFER

 +1        SET T=$SELECT($DATA(^DPT(DFN,"DA",DFN1,2,DFN2,0)):^(0),1:"")

           IF 'T

               QUIT 

           SET W=$SELECT($DATA(^DIC(42,+$PIECE(T,"^",4),0)):$PIECE(^(0),"^",1),1:"")

           SET B='(DGTY=1!(DGTY=2)!(DGTY=3))

 +2        IF W=""

               SET W=$SELECT($DATA(^DPT(DFN,.1)):^(.1),1:"")

           SET ^HNY(43.2,H,0)=R_"^"_W_"^"_$PIECE(T,"^",10)_"^"_B_"^3"

           QUIT 

4         ; DISCHARGE

 +1        SET ^HNY(43.2,H,0)=R_"^^^^4"

           QUIT 

5         ; CLINIC DISCHARGE

 +1        SET ^HNY(43.2,H,0)=R_"^^^^5"

           QUIT 

6         ; NAME CHANGE

 +1        KILL ^HNY(43.2,"B",$PIECE(R,"^",1),H)

           SET ^HNY(43.2,H,0)=X_"^"_$PIECE(R,"^",2)_"^^^^6^^"_$PIECE(R,"^",1)

           SET ^HNY(43.2,"B",X,H)=""

           QUIT 

7         ; SSN CHANGE

 +1        SET ^HNY(43.2,H,0)=$PIECE(R,"^",1)_"^"_DGHNOSSN_"^^^^7^"_$PIECE(R,"^",2)

           QUIT 

8         ; BED CHANGE

 +1        SET ^HNY(43.2,H,0)=R_"^"_$SELECT($DATA(^DPT(DFN,.1)):^(.1),1:"")_"^"_$SELECT($DATA(^(.101)):^(.101),1:"")_"^1^8"

           QUIT 

9         ; DELETED ADMISSION

 +1        SET ^HNY(43.2,H,0)=R_"^^^^9"

           QUIT 

10        ; DELETED DISCHARGE

 +1        SET ^HNY(43.2,H,0)=R_"^"_$SELECT($DATA(^DPT(DFN,.1)):^(.1),1:"")_"^"_$SELECT($DATA(^(.101)):^(.101),1:"")_"^1^10"

           QUIT