- AGEDIT ; IHS/ASDS/EFG - MAIN ROUTINE FOR EDITING A PATIENT;
- ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
- ;
- PATLK ;EP -
- S AG("PG")=0
- D PTLK^AG
- PATNLK ;PEP -- entry point for packages that already have patient name
- S AG("PG")=0
- Q:'$D(DFN)
- S AGPATDFN=$G(DFN) ;AG*7.1*1 FIX PROBLEM WITH CURRENT PAT. IN EDIT SCREEN CHANGING WHEN PATIENT LOOKUP IS USED (DFN CHANGES)
- L +^AUPNPAT(DFN):3 I '$T D Q
- . W !,*7,"Patient's record is being used, Try again soon" H 2
- ;L +^DPT(DFN):5 I '$T W !,"Patient's DPT record already in use! Try again later!" H 2 Q
- ;BEGIN NEW CODE IHS/SD/TPF 5/2/2006 AG*7.1*2 PAGE 12 ITEM 3
- I $$AGE^AGUTILS(AGPATDFN)<3,('$$DECEASED^AGEDERR2(AGPATDFN)) D AUTOADD^BIPATE(AGPATDFN,DUZ(2),.AGERR,"")
- ;END NEW CODE
- S AUPNPAT=DFN
- G:$D(AGXTERN)!($E($O(^AUPNPAT("D",999999)))'="T") SSNCK
- W !!,*7,"There are patients on file with TEMPORARY CHART NUMBERS.",!!
- W "Please print the list of these patients and supply the missing data.",!!
- SSNCK ;
- I $P($G(^DPT(DFN,0)),U,9)="" D G CONT
- . W !?5,"**** WARNING: SSN MISSING ("
- . W $S($P($G(^AUPNPAT(DFN,0)),U,24)=1:"Not Available",$P(^(0),U,24)=2:"Patient Refused",$P(^(0),U,24)=3:"Patient will Submit",1:"Reason for no SSN not yet entered")
- . W ") *****",!!
- E G:$D(AGXTERN)!($E($O(^AUPNPAT("D",999999)))'="T") DATCK
- CONT ;
- DATCK ;
- D ^AGDATCK
- I AG("DTOT")>0 D ^AGBADATA I $D(DUOUT)!$D(DTOUT)!$D(DFOUT) K:$D(AGXTERN) DFN Q
- ELIG ;
- K AG("ELIG")
- I AGOPT(14)="Y" G BICELIG
- I $D(^AUPNPAT(DFN,11)),$P(^(11),U,12)]"","I"[$P(^(11),U,12) D
- . W !!,*7,"Patient has been designated ""INELIGIBLE"".",!!
- . S AG("ELIG")=""
- G CLASS
- BICELIG ;
- I $D(^AUPNPAT(DFN,11)),+$P(^(11),U,24)>2 D
- . W !!,*7,"Patient has been designated:",!
- . W $P(^AUTTBICE($P(^AUPNPAT(DFN,11),U,24),0),U),!!
- . S AG("ELIG")=""
- CLASS ;
- I $D(^AUPNPAT(DFN,11)),$D(AG("ELIG")),$P(^(11),U,11)]"",$D(^AUTTBEN($P(^AUPNPAT(DFN,11),U,11),0)) W "Patient is classified as: ",$P(^(0),U),!! K DIR S DIR(0)="E" S DIR("A")="Press the RETURN key to continue. " D ^DIR
- K AG("ELIG")
- DFN ;Pre-determined patient (DFN) defined.
- L1 ;
- Q:'$D(DFN)
- I "YC"[AGOPT(14) D
- . S AG("SVELIG")=""
- . I $D(^AUPNPAT(DFN,11)),$P(^(11),U,12)]"" S AG("SVELIG")=$P(^(11),U,12)
- I '$D(^DPT(DFN,0)) K:$D(AGXTERN) DFN Q
- S AGPAT=$P($G(^DPT(DFN,0)),U)
- S AGCHRT=$S($D(^AUPNPAT(DFN,41,DUZ(2),0)):$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2),1:"xxxxx")
- S AG("AUPN")=""
- S:$D(^AUPNPAT(DFN,0)) AG("AUPN")=^(0)
- S AGLINE("-")=$TR($J(" ",78)," ","-")
- S AGLINE("EQ")=$TR($J(" ",78)," ","=")
- Q:$D(AGXTERN)
- I '$D(AGXTERN) D EDCHEK
- D ^AGED1
- L -^AUPNPAT(DFN)
- ;L -^DPT(DFN) ;AG*7,1*2 ADDING APIS WITH EDITS
- K DFOUT,DTOUT,DUOUT
- K AGSELECT
- Q
- EDCHEK ;EP
- K MYERRS,MYVARS
- D FETCHERR^AGEDERR(AG("PG"),.MYERRS)
- S MYVARS("DFN")=DFN,MYVARS("FINDCALL")="",MYVARS("SITE")=DUZ(2)
- D EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
- I $$PATREFBC^AGEDERR(DFN) W !!,"**PATIENT HAS AN OPEN BENEFITS CASE**"
- W !
- K DIR
- S DIR("A")="Press the RETURN key to continue. "
- S DIR(0)="E"
- D ^DIR
- Q
- AGEDIT ; IHS/ASDS/EFG - MAIN ROUTINE FOR EDITING A PATIENT;
- +1 ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
- +2 ;
- PATLK ;EP -
- +1 SET AG("PG")=0
- +2 DO PTLK^AG
- PATNLK ;PEP -- entry point for packages that already have patient name
- +1 SET AG("PG")=0
- +2 IF '$DATA(DFN)
- QUIT
- +3 ;AG*7.1*1 FIX PROBLEM WITH CURRENT PAT. IN EDIT SCREEN CHANGING WHEN PATIENT LOOKUP IS USED (DFN CHANGES)
- SET AGPATDFN=$GET(DFN)
- +4 LOCK +^AUPNPAT(DFN):3
- IF '$TEST
- Begin DoDot:1
- +5 WRITE !,*7,"Patient's record is being used, Try again soon"
- HANG 2
- End DoDot:1
- QUIT
- +6 ;L +^DPT(DFN):5 I '$T W !,"Patient's DPT record already in use! Try again later!" H 2 Q
- +7 ;BEGIN NEW CODE IHS/SD/TPF 5/2/2006 AG*7.1*2 PAGE 12 ITEM 3
- +8 IF $$AGE^AGUTILS(AGPATDFN)<3
- IF ('$$DECEASED^AGEDERR2(AGPATDFN))
- DO AUTOADD^BIPATE(AGPATDFN,DUZ(2),.AGERR,"")
- +9 ;END NEW CODE
- +10 SET AUPNPAT=DFN
- +11 IF $DATA(AGXTERN)!($EXTRACT($ORDER(^AUPNPAT("D",999999)))'="T")
- GOTO SSNCK
- +12 WRITE !!,*7,"There are patients on file with TEMPORARY CHART NUMBERS.",!!
- +13 WRITE "Please print the list of these patients and supply the missing data.",!!
- SSNCK ;
- +1 IF $PIECE($GET(^DPT(DFN,0)),U,9)=""
- Begin DoDot:1
- +2 WRITE !?5,"**** WARNING: SSN MISSING ("
- +3 WRITE $SELECT($PIECE($GET(^AUPNPAT(DFN,0)),U,24)=1:"Not Available",$PIECE(^(0),U,24)=2:"Patient Refused",$PIECE(^(0),U,24)=3:"Patient will Submit",1:"Reason for no SSN not yet entered")
- +4 WRITE ") *****",!!
- End DoDot:1
- GOTO CONT
- +5 IF '$TEST
- IF $DATA(AGXTERN)!($EXTRACT($ORDER(^AUPNPAT("D",999999)))'="T")
- GOTO DATCK
- CONT ;
- DATCK ;
- +1 DO ^AGDATCK
- +2 IF AG("DTOT")>0
- DO ^AGBADATA
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- IF $DATA(AGXTERN)
- KILL DFN
- QUIT
- ELIG ;
- +1 KILL AG("ELIG")
- +2 IF AGOPT(14)="Y"
- GOTO BICELIG
- +3 IF $DATA(^AUPNPAT(DFN,11))
- IF $PIECE(^(11),U,12)]""
- IF "I"[$PIECE(^(11),U,12)
- Begin DoDot:1
- +4 WRITE !!,*7,"Patient has been designated ""INELIGIBLE"".",!!
- +5 SET AG("ELIG")=""
- End DoDot:1
- +6 GOTO CLASS
- BICELIG ;
- +1 IF $DATA(^AUPNPAT(DFN,11))
- IF +$PIECE(^(11),U,24)>2
- Begin DoDot:1
- +2 WRITE !!,*7,"Patient has been designated:",!
- +3 WRITE $PIECE(^AUTTBICE($PIECE(^AUPNPAT(DFN,11),U,24),0),U),!!
- +4 SET AG("ELIG")=""
- End DoDot:1
- CLASS ;
- +1 IF $DATA(^AUPNPAT(DFN,11))
- IF $DATA(AG("ELIG"))
- IF $PIECE(^(11),U,11)]""
- IF $DATA(^AUTTBEN($PIECE(^AUPNPAT(DFN,11),U,11),0))
- WRITE "Patient is classified as: ",$PIECE(^(0),U),!!
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press the RETURN key to continue. "
- DO ^DIR
- +2 KILL AG("ELIG")
- DFN ;Pre-determined patient (DFN) defined.
- L1 ;
- +1 IF '$DATA(DFN)
- QUIT
- +2 IF "YC"[AGOPT(14)
- Begin DoDot:1
- +3 SET AG("SVELIG")=""
- +4 IF $DATA(^AUPNPAT(DFN,11))
- IF $PIECE(^(11),U,12)]""
- SET AG("SVELIG")=$PIECE(^(11),U,12)
- End DoDot:1
- +5 IF '$DATA(^DPT(DFN,0))
- IF $DATA(AGXTERN)
- KILL DFN
- QUIT
- +6 SET AGPAT=$PIECE($GET(^DPT(DFN,0)),U)
- +7 SET AGCHRT=$SELECT($DATA(^AUPNPAT(DFN,41,DUZ(2),0)):$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2),1:"xxxxx")
- +8 SET AG("AUPN")=""
- +9 IF $DATA(^AUPNPAT(DFN,0))
- SET AG("AUPN")=^(0)
- +10 SET AGLINE("-")=$TRANSLATE($JUSTIFY(" ",78)," ","-")
- +11 SET AGLINE("EQ")=$TRANSLATE($JUSTIFY(" ",78)," ","=")
- +12 IF $DATA(AGXTERN)
- QUIT
- +13 IF '$DATA(AGXTERN)
- DO EDCHEK
- +14 DO ^AGED1
- +15 LOCK -^AUPNPAT(DFN)
- +16 ;L -^DPT(DFN) ;AG*7,1*2 ADDING APIS WITH EDITS
- +17 KILL DFOUT,DTOUT,DUOUT
- +18 KILL AGSELECT
- +19 QUIT
- EDCHEK ;EP
- +1 KILL MYERRS,MYVARS
- +2 DO FETCHERR^AGEDERR(AG("PG"),.MYERRS)
- +3 SET MYVARS("DFN")=DFN
- SET MYVARS("FINDCALL")=""
- SET MYVARS("SITE")=DUZ(2)
- +4 DO EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
- +5 IF $$PATREFBC^AGEDERR(DFN)
- WRITE !!,"**PATIENT HAS AN OPEN BENEFITS CASE**"
- +6 WRITE !
- +7 KILL DIR
- +8 SET DIR("A")="Press the RETURN key to continue. "
- +9 SET DIR(0)="E"
- +10 DO ^DIR
- +11 QUIT
