AG1 ; IHS/ASDS/EFG - ENTER HEALTH RECORD NUMBER ; MAR 19, 2010
;;7.1;PATIENT REGISTRATION;**7,9**;AUG 25, 2005
;
I $D(AGDOG) D ^AGCHTMP Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)!'$D(AG("TEMP CHART")) S AG("CH")=AG("TEMP CHART") G L3
Q:'$D(DFN)
S DIE="^AUPNPAT("
S DA=DFN
K:'$D(^AUPNPAT(DFN,41,DUZ(2),0)) AG("EDIT")
L1 ;
W !!,"Enter the CHART NUMBER: "
I $D(^AUPNPAT(DFN,41,DUZ(2),0)) D
. S (AG("CH"),AG("OCH"))=$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
. W AG("CH"),"// "
. S AG("EDIT")=""
E S (AG("CH"),AG("OCH"))=""
; fill in missing first piece if gone
I $D(^AUPNPAT(DFN,41,DUZ(2),0)),$P(^AUPNPAT(DFN,41,DUZ(2),0),U)="" D
. S $P(^AUPNPAT(DFN,41,DUZ(2),0),U)=DUZ(2)
D READ^AG
G K:$D(DFOUT)!$D(DTOUT)
G SSN:($D(DLOUT)&$D(AG("EDIT")))
Q:$D(DUOUT)
I $D(DQOUT)!(Y'?1N.N)!($L(Y)>6)!(+Y<1) D G L1
. W !!,"Enter the 1 to 6-digit IHS CHART NUMBER."
;HL7 INTERFACE -- PUT PATIENT DFN INTO TEMP ARRAY FOR HL7 CALL
S ^XTMP("AGHL7",DUZ(2),DFN)=DA ;AG*7.1*9 - Added DUZ(2) subscript
S ^XTMP("AGHL7AG",DUZ(2),DFN,"UPDATE")="" ;AG*7.1*9 - Added DUZ(2) subscript
;
S AG("CH")=+Y
S AG("CH1")=AG("CH")-1
S AG("CH1")=$O(^AUPNPAT("D",AG("CH1")))
G L3:AG("CH")'=AG("CH1")!(AG("CH1")="")
S AG("D")=0
I Y="" W *7 G L1
L2 ;
S AG("D")=$O(^AUPNPAT("D",AG("CH1"),AG("D")))
G L3:AG("D")=""
S AG("DD")=0
TPGL2HLF ;
S AG("DD")=$O(^AUPNPAT("D",AG("CH1"),AG("D"),AG("DD")))
G L2:AG("DD")=""
G TPGL2HLF:AG("DD")'=DUZ(2)
W !!,*7,AG("CH")," is already assigned to ",$S($P($G(^DPT(AG("D"),0)),U)'="":$P($G(^DPT(AG("D"),0)),U),1:"UNDEFINED RECORD")
I $P($G(^DPT(AG("D"),0)),U)="" D G L1
.W !,"There is a dangling ""D"" cross reference in the PATIENT file."
.W !,"The HRN ",AG("CH")_" is in use by this cross reference."
.W !,"Please report this to the help desk"
.H 3
G L1
L3 ;
S DIE="^AUPNPAT("
S DA=DFN
S DR="4101///"_"`"_DUZ(2)
S DR(2,9000001.41)=".02///"_AG("CH")
D ^DIE
K DIE,DA,DR
S AG("K")=""
G SSN
S:'$D(^AUPNPAT(DFN,41,0)) ^AUPNPAT(DFN,41,0)="^9000001.41IP^^"
K DIC,DR
S X=$P(^DIC(4,DUZ(2),0),U)
S DIC="^AUPNPAT("_DFN_",41,"
S DA(1)=DFN
S DIC(0)="ML"
D ^DIC
S DIE="^AUPNPAT("_DFN_",41,"
S DA=DUZ(2)
S DA(1)=DFN
S DR=".02///"_AG("CH")
D ^DIE
K DA,DIE,DR
K S AG("K")=""
SSN ;
D NOSSN^AG3A:$P(^DPT(DFN,0),U,9)=""
I $D(DUOUT) K DUOUT G AG1
Q
AG1 ; IHS/ASDS/EFG - ENTER HEALTH RECORD NUMBER ; MAR 19, 2010
+1 ;;7.1;PATIENT REGISTRATION;**7,9**;AUG 25, 2005
+2 ;
+3 IF $DATA(AGDOG)
DO ^AGCHTMP
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)!'$DATA(AG("TEMP CHART"))
QUIT
SET AG("CH")=AG("TEMP CHART")
GOTO L3
+4 IF '$DATA(DFN)
QUIT
+5 SET DIE="^AUPNPAT("
+6 SET DA=DFN
+7 IF '$DATA(^AUPNPAT(DFN,41,DUZ(2),0))
KILL AG("EDIT")
L1 ;
+1 WRITE !!,"Enter the CHART NUMBER: "
+2 IF $DATA(^AUPNPAT(DFN,41,DUZ(2),0))
Begin DoDot:1
+3 SET (AG("CH"),AG("OCH"))=$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
+4 WRITE AG("CH"),"// "
+5 SET AG("EDIT")=""
End DoDot:1
+6 IF '$TEST
SET (AG("CH"),AG("OCH"))=""
+7 ; fill in missing first piece if gone
+8 IF $DATA(^AUPNPAT(DFN,41,DUZ(2),0))
IF $PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U)=""
Begin DoDot:1
+9 SET $PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U)=DUZ(2)
End DoDot:1
+10 DO READ^AG
+11 IF $DATA(DFOUT)!$DATA(DTOUT)
GOTO K
+12 IF ($DATA(DLOUT)&$DATA(AG("EDIT")))
GOTO SSN
+13 IF $DATA(DUOUT)
QUIT
+14 IF $DATA(DQOUT)!(Y'?1N.N)!($LENGTH(Y)>6)!(+Y<1)
Begin DoDot:1
+15 WRITE !!,"Enter the 1 to 6-digit IHS CHART NUMBER."
End DoDot:1
GOTO L1
+16 ;HL7 INTERFACE -- PUT PATIENT DFN INTO TEMP ARRAY FOR HL7 CALL
+17 ;AG*7.1*9 - Added DUZ(2) subscript
SET ^XTMP("AGHL7",DUZ(2),DFN)=DA
+18 ;AG*7.1*9 - Added DUZ(2) subscript
SET ^XTMP("AGHL7AG",DUZ(2),DFN,"UPDATE")=""
+19 ;
+20 SET AG("CH")=+Y
+21 SET AG("CH1")=AG("CH")-1
+22 SET AG("CH1")=$ORDER(^AUPNPAT("D",AG("CH1")))
+23 IF AG("CH")'=AG("CH1")!(AG("CH1")="")
GOTO L3
+24 SET AG("D")=0
+25 IF Y=""
WRITE *7
GOTO L1
L2 ;
+1 SET AG("D")=$ORDER(^AUPNPAT("D",AG("CH1"),AG("D")))
+2 IF AG("D")=""
GOTO L3
+3 SET AG("DD")=0
TPGL2HLF ;
+1 SET AG("DD")=$ORDER(^AUPNPAT("D",AG("CH1"),AG("D"),AG("DD")))
+2 IF AG("DD")=""
GOTO L2
+3 IF AG("DD")'=DUZ(2)
GOTO TPGL2HLF
+4 WRITE !!,*7,AG("CH")," is already assigned to ",$SELECT($PIECE($GET(^DPT(AG("D"),0)),U)'="":$PIECE($GET(^DPT(AG("D"),0)),U),1:"UNDEFINED RECORD")
+5 IF $PIECE($GET(^DPT(AG("D"),0)),U)=""
Begin DoDot:1
+6 WRITE !,"There is a dangling ""D"" cross reference in the PATIENT file."
+7 WRITE !,"The HRN ",AG("CH")_" is in use by this cross reference."
+8 WRITE !,"Please report this to the help desk"
+9 HANG 3
End DoDot:1
GOTO L1
+10 GOTO L1
L3 ;
+1 SET DIE="^AUPNPAT("
+2 SET DA=DFN
+3 SET DR="4101///"_"`"_DUZ(2)
+4 SET DR(2,9000001.41)=".02///"_AG("CH")
+5 DO ^DIE
+6 KILL DIE,DA,DR
+7 SET AG("K")=""
+8 GOTO SSN
+9 IF '$DATA(^AUPNPAT(DFN,41,0))
SET ^AUPNPAT(DFN,41,0)="^9000001.41IP^^"
+10 KILL DIC,DR
+11 SET X=$PIECE(^DIC(4,DUZ(2),0),U)
+12 SET DIC="^AUPNPAT("_DFN_",41,"
+13 SET DA(1)=DFN
+14 SET DIC(0)="ML"
+15 DO ^DIC
+16 SET DIE="^AUPNPAT("_DFN_",41,"
+17 SET DA=DUZ(2)
+18 SET DA(1)=DFN
+19 SET DR=".02///"_AG("CH")
+20 DO ^DIE
+21 KILL DA,DIE,DR
K SET AG("K")=""
SSN ;
+1 IF $PIECE(^DPT(DFN,0),U,9)=""
DO NOSSN^AG3A
+2 IF $DATA(DUOUT)
KILL DUOUT
GOTO AG1
+3 QUIT
