- 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
