- AGACT ; IHS/ASDS/EFG - INACTIVATE/ACTIVATE A PATIENT'S FILE (BY FACILITY) ;
- ;;7.1;PATIENT REGISTRATION;**1,2,5,9**;AUG 25, 2005
- A1 S AG("LINE")="=" D LINE^AG W !?25,"1... INACTIVATE a file",!!?25,"2... ACTIVATE a file",!!?25,"Select 1 or 2 : " D READ^AG G END:$D(DTOUT)!$D(DFOUT)!$D(DUOUT)!$D(DLOUT),A1:+Y<1!(+Y>2)
- S AG("CH")=+Y W !!,$S(+Y=1:"IN",1:""),"ACTIVATE..."
- W !! K DIC S AUPNLK("INAC")="" D PTLK^AG K AUPNLK("INAC")
- W !! G A1:$D(DUOUT),END:'$D(DFN),C1:AG("CH")=2
- B ;Lookup Patient and Inactivate.
- B2 W !!,"You wish to inactivate ",$P(^DPT(DFN,0),U),!!,"CORRECT? (Y/N) " D READ^AG G A1:$D(DTOUT)!$D(DFOUT)!$D(DUOUT)!(Y["N"),B2A:Y["Y" D YN^AG G B2
- B2A I $P(^AUPNPAT(DFN,41,DUZ(2),0),U,5)="D" W !!,*7,"This patient has been deleted - no action taken." H 3 G END
- ;K DIC,DR,DA S DA(1)=DFN,DA=DUZ(2),DIE="^AUPNPAT("_DFN_",41,",DR=".03///"_DT D ^DIE ;new FM data sets
- ;BEGIN NEW CODE IHS/SD/TPF AG*7.1*1 ITEM 9
- K DIC,DIE,DA,DR
- S DA(1)=DFN,DA=DUZ(2)
- S DIE="^AUPNPAT("_DFN_",41,"
- S DR=".03R",DIE("NO^")=""
- D ^DIE
- ;END NEW CODE
- D HELP
- I Y]"" K DIC,DR,DA S DA(1)=DFN,DA=DUZ(2),DIE="^AUPNPAT("_DFN_",41,",DR=".04///"_Y D ^DIE ; new FM data sets
- W !!,"The file is now inactive." H 2
- ;HL7 INTERFACE -- PUT PATIENT DFN INTO TEMP ARRAY FOR HL7 CALL
- ;S ^XTMP("AGHL7",DA)=DA
- S ^XTMP("AGHL7AG",DUZ(2),DFN,"UPDATE")="" ;fje062909 AG*7.1*5 EDR ;AG*7.1*9 - Added DUZ(2) subscript
- ;BEGIN NEW CODE IHS/SD/TPF 5/2/2006 AG*7.1*2 PAGE 12 ITEM 3
- I $$AGE^AGUTILS(DFN)<3 D AUTOADD^BIPATE(DFN,DUZ(2),.AGERR,DT)
- ;END NEW CODE
- I '$D(AG("DELETE")) K DIC,DR,DA S DA(1)=DFN,DA=DUZ(2),DIE="^AUPNPAT("_DFN_",41,",DR=".05///"_"I" D ^DIE G A1 ;new FM data sets
- G END
- C1 ;EP - From ^AG0 to Activate a Pre-REG Patient.
- W !,"RECORD DISPOSITION is:",!?5,"DATE INACTIVATED/DELETED : " S Y=$P(^AUPNPAT(DFN,41,DUZ(2),0),U,3) D DD^%DT W Y I $P(^AUPNPAT(DFN,41,DUZ(2),0),U,4)]"" W !?5,$P(^AUTTDIS($P(^(0),U,4),0),U),!,$P(^(0),U,2),!
- W !!,"You wish to activate ",$P(^DPT(DFN,0),U),!!,"CORRECT? (Y/N) " D READ^AG G C1A:$D(AG("EDIT")),A1:$D(DTOUT)!$D(DFOUT)!$D(DUOUT)!(Y["N"),C2:Y["Y" D YN^AG G C1
- C1A I $D(AG("EDIT")) G END:$D(DUOUT)!$D(DFOUT)!$D(DTOUT)!(Y["N"),C2:Y["Y" D YN^AG G C1
- C2 ;
- S $P(^AUPNPAT(DFN,41,DUZ(2),0),U,3)="",$P(^(0),U,4)="",$P(^(0),U,5)=""
- K DIC,DR,DA S DA(1)=DFN,DA=DUZ(2),DIE="^AUPNPAT("_DFN_",41,",DR=".03///@;.04///@;.05///@" D ^DIE ; new FM data sets
- W !!,"The file is now active." H 2 S ^XTMP("AGHL7AG",DUZ(2),DFN,"UPDATE")="" G A1:'$D(AG("EDIT")) K AG Q ;fje062909 AG*7.1*5 EDR ;AG*7.1*9 - Added DUZ(2) subscript
- END K AG,DFN
- Q
- HELP W !!!,"Select the record disposition from among the following:",! S (AG("DIS"),AG("I"))=0
- F AG("I")=1:1 S AG("DIS")=$O(^AUTTDIS(AG("DIS"))) Q:+AG("DIS")<1 S AG(AG("I"))=AG("DIS") W !,AG("I"),".",?5,$P(^AUTTDIS(AG("DIS"),0),U),!,$P(^(0),U,2),!
- W !,"Enter 1 - ",AG("I")-1," " D READ^AG Q:$D(DTOUT)!$D(DFOUT)!$D(DUOUT)!$D(DQOUT)!$D(DLOUT) I $D(AG(+Y)) S Y=AG(+Y) Q
- W *7,"??" G HELP
- AGACT ; IHS/ASDS/EFG - INACTIVATE/ACTIVATE A PATIENT'S FILE (BY FACILITY) ;
- +1 ;;7.1;PATIENT REGISTRATION;**1,2,5,9**;AUG 25, 2005
- A1 SET AG("LINE")="="
- DO LINE^AG
- WRITE !?25,"1... INACTIVATE a file",!!?25,"2... ACTIVATE a file",!!?25,"Select 1 or 2 : "
- DO READ^AG
- IF $DATA(DTOUT)!$DATA(DFOUT)!$DATA(DUOUT)!$DATA(DLOUT)
- GOTO END
- IF +Y<1!(+Y>2)
- GOTO A1
- +1 SET AG("CH")=+Y
- WRITE !!,$SELECT(+Y=1:"IN",1:""),"ACTIVATE..."
- +2 WRITE !!
- KILL DIC
- SET AUPNLK("INAC")=""
- DO PTLK^AG
- KILL AUPNLK("INAC")
- +3 WRITE !!
- IF $DATA(DUOUT)
- GOTO A1
- IF '$DATA(DFN)
- GOTO END
- IF AG("CH")=2
- GOTO C1
- B ;Lookup Patient and Inactivate.
- B2 WRITE !!,"You wish to inactivate ",$PIECE(^DPT(DFN,0),U),!!,"CORRECT? (Y/N) "
- DO READ^AG
- IF $DATA(DTOUT)!$DATA(DFOUT)!$DATA(DUOUT)!(Y["N")
- GOTO A1
- IF Y["Y"
- GOTO B2A
- DO YN^AG
- GOTO B2
- B2A IF $PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,5)="D"
- WRITE !!,*7,"This patient has been deleted - no action taken."
- HANG 3
- GOTO END
- +1 ;K DIC,DR,DA S DA(1)=DFN,DA=DUZ(2),DIE="^AUPNPAT("_DFN_",41,",DR=".03///"_DT D ^DIE ;new FM data sets
- +2 ;BEGIN NEW CODE IHS/SD/TPF AG*7.1*1 ITEM 9
- +3 KILL DIC,DIE,DA,DR
- +4 SET DA(1)=DFN
- SET DA=DUZ(2)
- +5 SET DIE="^AUPNPAT("_DFN_",41,"
- +6 SET DR=".03R"
- SET DIE("NO^")=""
- +7 DO ^DIE
- +8 ;END NEW CODE
- +9 DO HELP
- +10 ; new FM data sets
- IF Y]""
- KILL DIC,DR,DA
- SET DA(1)=DFN
- SET DA=DUZ(2)
- SET DIE="^AUPNPAT("_DFN_",41,"
- SET DR=".04///"_Y
- DO ^DIE
- +11 WRITE !!,"The file is now inactive."
- HANG 2
- +12 ;HL7 INTERFACE -- PUT PATIENT DFN INTO TEMP ARRAY FOR HL7 CALL
- +13 ;S ^XTMP("AGHL7",DA)=DA
- +14 ;fje062909 AG*7.1*5 EDR ;AG*7.1*9 - Added DUZ(2) subscript
- SET ^XTMP("AGHL7AG",DUZ(2),DFN,"UPDATE")=""
- +15 ;BEGIN NEW CODE IHS/SD/TPF 5/2/2006 AG*7.1*2 PAGE 12 ITEM 3
- +16 IF $$AGE^AGUTILS(DFN)<3
- DO AUTOADD^BIPATE(DFN,DUZ(2),.AGERR,DT)
- +17 ;END NEW CODE
- +18 ;new FM data sets
- IF '$DATA(AG("DELETE"))
- KILL DIC,DR,DA
- SET DA(1)=DFN
- SET DA=DUZ(2)
- SET DIE="^AUPNPAT("_DFN_",41,"
- SET DR=".05///"_"I"
- DO ^DIE
- GOTO A1
- +19 GOTO END
- C1 ;EP - From ^AG0 to Activate a Pre-REG Patient.
- +1 WRITE !,"RECORD DISPOSITION is:",!?5,"DATE INACTIVATED/DELETED : "
- SET Y=$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,3)
- DO DD^%DT
- WRITE Y
- IF $PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,4)]""
- WRITE !?5,$PIECE(^AUTTDIS($PIECE(^(0),U,4),0),U),!,$PIECE(^(0),U,2),!
- +2 WRITE !!,"You wish to activate ",$PIECE(^DPT(DFN,0),U),!!,"CORRECT? (Y/N) "
- DO READ^AG
- IF $DATA(AG("EDIT"))
- GOTO C1A
- IF $DATA(DTOUT)!$DATA(DFOUT)!$DATA(DUOUT)!(Y["N")
- GOTO A1
- IF Y["Y"
- GOTO C2
- DO YN^AG
- GOTO C1
- C1A IF $DATA(AG("EDIT"))
- IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)!(Y["N")
- GOTO END
- IF Y["Y"
- GOTO C2
- DO YN^AG
- GOTO C1
- C2 ;
- +1 SET $PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,3)=""
- SET $PIECE(^(0),U,4)=""
- SET $PIECE(^(0),U,5)=""
- +2 ; new FM data sets
- KILL DIC,DR,DA
- SET DA(1)=DFN
- SET DA=DUZ(2)
- SET DIE="^AUPNPAT("_DFN_",41,"
- SET DR=".03///@;.04///@;.05///@"
- DO ^DIE
- +3 ;fje062909 AG*7.1*5 EDR ;AG*7.1*9 - Added DUZ(2) subscript
- WRITE !!,"The file is now active."
- HANG 2
- SET ^XTMP("AGHL7AG",DUZ(2),DFN,"UPDATE")=""
- IF '$DATA(AG("EDIT"))
- GOTO A1
- KILL AG
- QUIT
- END KILL AG,DFN
- +1 QUIT
- HELP WRITE !!!,"Select the record disposition from among the following:",!
- SET (AG("DIS"),AG("I"))=0
- +1 FOR AG("I")=1:1
- SET AG("DIS")=$ORDER(^AUTTDIS(AG("DIS")))
- IF +AG("DIS")<1
- QUIT
- SET AG(AG("I"))=AG("DIS")
- WRITE !,AG("I"),".",?5,$PIECE(^AUTTDIS(AG("DIS"),0),U),!,$PIECE(^(0),U,2),!
- +2 WRITE !,"Enter 1 - ",AG("I")-1," "
- DO READ^AG
- IF $DATA(DTOUT)!$DATA(DFOUT)!$DATA(DUOUT)!$DATA(DQOUT)!$DATA(DLOUT)
- QUIT
- IF $DATA(AG(+Y))
- SET Y=AG(+Y)
- QUIT
- +3 WRITE *7,"??"
- GOTO HELP
