AGDELPAT.m

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