- AGDELPAT ; IHS/ASDS/EFG - DELETE HRN ;
- ;;7.1;PATIENT REGISTRATION;**5,9**;AUG 25, 2005
- ;
- NODFN ;EP - Without Pre-Defined Patient.
- K DIC S AUPNLK("INAC")="" D PTLK^AG K AUPNLK("INAC")
- Q:'$D(DFN) S AG("NAME")=$P(^DPT(DFN,0),U)
- NODFN1 W !!,"You wish to delete the Health Record Number for """,AG("NAME"),""".",!," CORRECT? (Y/N) N// "
- D READ^AG G END:$D(DTOUT)!$D(DFOUT),NODFN:$D(DUOUT) S Y=$E(Y_"N") I $D(DQOUT)!("YN"'[Y) D YN^AG G NODFN1
- G NODFN:Y'="Y"
- DFN ;
- I +$P(^AUPNPAT(DFN,41,0),U,4)=1,$P(^DPT(DFN,0),U,9)]"" D SSN G:Y="S" END
- D INITL^AGMAN D NOW^%DTC S X=% ; Do not Delay export of delete.
- S ^AGPATCH(X,DUZ(2),DFN)=DUZ(2)_U_$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2)_"^^"_AG("INITL")_U_$P(^DPT(DFN,0),U,2)
- S DA(1)=DFN,DA=DUZ(2),DIE="^AUPNPAT("_DA(1)_",41,",DR=".03////"_DT_";.05////D" D ^DIE
- W !!,"The Health Record Number for ",AG("NAME")," is deleted.",!!
- S ^XTMP("AGHL7AG",DUZ(2),DFN,"UPDATE")="" ;fje 07082009 AG*7.1*5 ;AG*7.1*9 - Added DUZ(2) subscript
- K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT
- K DIR
- S DIR(0)="E"
- S DIR("A")="Press RETURN..."
- D ^DIR
- END K AGDT,DFN
- Q
- SSN W *7,!!,"This is the only HRN for this patient.",!,"If the HRN and/or SSN (",$P(^DPT(DFN,0),U,9),") were entered in error,",!,"and you want to use the SSN for another entry,",!,"you must delete the SSN before deleting the HRN.",!
- F AGZ("I")=1:1 W !?10,"[S]top, [C]ontinue with HRN delete? (S/C) S// " D READ^AG S Y=$E(Y_"S") Q:"SC"[Y&('$D(DQOUT)) W *7,!,"Please enter 'S' or 'C'."
- Q
- AGDELPAT ; IHS/ASDS/EFG - DELETE HRN ;
- +1 ;;7.1;PATIENT REGISTRATION;**5,9**;AUG 25, 2005
- +2 ;
- NODFN ;EP - Without Pre-Defined Patient.
- +1 KILL DIC
- SET AUPNLK("INAC")=""
- DO PTLK^AG
- KILL AUPNLK("INAC")
- +2 IF '$DATA(DFN)
- QUIT
- SET AG("NAME")=$PIECE(^DPT(DFN,0),U)
- NODFN1 WRITE !!,"You wish to delete the Health Record Number for """,AG("NAME"),""".",!," CORRECT? (Y/N) N// "
- +1 DO READ^AG
- IF $DATA(DTOUT)!$DATA(DFOUT)
- GOTO END
- IF $DATA(DUOUT)
- GOTO NODFN
- SET Y=$EXTRACT(Y_"N")
- IF $DATA(DQOUT)!("YN"'[Y)
- DO YN^AG
- GOTO NODFN1
- +2 IF Y'="Y"
- GOTO NODFN
- DFN ;
- +1 IF +$PIECE(^AUPNPAT(DFN,41,0),U,4)=1
- IF $PIECE(^DPT(DFN,0),U,9)]""
- DO SSN
- IF Y="S"
- GOTO END
- +2 ; Do not Delay export of delete.
- DO INITL^AGMAN
- DO NOW^%DTC
- SET X=%
- +3 SET ^AGPATCH(X,DUZ(2),DFN)=DUZ(2)_U_$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2)_"^^"_AG("INITL")_U_$PIECE(^DPT(DFN,0),U,2)
- +4 SET DA(1)=DFN
- SET DA=DUZ(2)
- SET DIE="^AUPNPAT("_DA(1)_",41,"
- SET DR=".03////"_DT_";.05////D"
- DO ^DIE
- +5 WRITE !!,"The Health Record Number for ",AG("NAME")," is deleted.",!!
- +6 ;fje 07082009 AG*7.1*5 ;AG*7.1*9 - Added DUZ(2) subscript
- SET ^XTMP("AGHL7AG",DUZ(2),DFN,"UPDATE")=""
- +7 KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT
- +8 KILL DIR
- +9 SET DIR(0)="E"
- +10 SET DIR("A")="Press RETURN..."
- +11 DO ^DIR
- END KILL AGDT,DFN
- +1 QUIT
- SSN WRITE *7,!!,"This is the only HRN for this patient.",!,"If the HRN and/or SSN (",$PIECE(^DPT(DFN,0),U,9),") were entered in error,",!,"and you want to use the SSN for another entry,",!,"you must delete the SSN before deleting the HRN.",!
- +1 FOR AGZ("I")=1:1
- WRITE !?10,"[S]top, [C]ontinue with HRN delete? (S/C) S// "
- DO READ^AG
- SET Y=$EXTRACT(Y_"S")
- IF "SC"[Y&('$DATA(DQOUT))
- QUIT
- WRITE *7,!,"Please enter 'S' or 'C'."
- +2 QUIT
