Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AG0

AG0.m

Go to the documentation of this file. 
  1. AG0 ; IHS/ASDS/EFG - Add a patient opening page ; MAR 19, 2010    
  1.  ;;7.1;PATIENT REGISTRATION;**1,2,7,8,9,10**;AUG 25, 2005;Build 7
  1.  ;
  1.  K DOG,AGDOG
  1.  ;
  1. DOG ;PEP - From Other Systems.
  1.  D ^AGVAR
  1.  I $D(DOG) S AGDOG=DOG  ;renamespace external call variable
  1. VAR ; 
  1.  W:$D(AGDOG) @IOF,!,"ADD a new patient......"
  1.  K AG,DFN
  1. R1 ;
  1.  G L0:$D(DFN)
  1.  ;IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 13 PAGE 11
  1.  ;K DIR
  1.  ;S DIR(0)="Y"
  1.  ;S DIR("B")="YES"
  1.  ;S DIR("A")="Do you wish to SCAN FOR SIMILAR NAMES or CHART NUMBERS? (Y/N) "
  1.  ;S DIR("T")=DTIME
  1.  ;D ^DIR
  1.  ;Q:$D(DFOUT)!$D(DTOUT)!$D(DUOUT)
  1.  ;G L0:Y=0
  1.  ;G R2:Y=1!$D(DLOUT)
  1.  ;G R1
  1.  ;END IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 13 PAGE 11
  1. R2 ;
  1.  W !!,"You must first SCAN FOR SIMILAR NAMES or CHART NUMBERS NOW..."  ;IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 13 PAGE 11
  1.  K DIC
  1.  S DIC("W")="D ^AGSCANP"
  1.  D SET^AUPNLKZ               ; Set DUZ(2) to 0
  1.  D PTLK^AG                   ; Std pat lookup using DIC, returns DFN
  1.  S AGPATDFN=$G(DFN)              ;PHASE OUT USE OF DFN TO AVOID CHANGES WHEN CALLING DIC
  1.  D RESET^AUPNLKZ             ; Set DUZ(2) back to original value
  1.  ;G R1  ;IHS/SD/TPF 4/12/2006 AG*7.1*2 ITEM 13 PAGE 11
  1. L0 ;
  1.  K AG
  1.  G L1:'$D(DFN)
  1.  S AGPATDFN=DFN              ;PHASE OUT USE OF DFN TO AVOID CHANGES WHEN CALLING DIC
  1.  G L0A:'$D(^AUPNPAT(DFN,41,DUZ(2)))
  1.  G L0C:$P(^AUPNPAT(DFN,41,DUZ(2),0),U,3)]""
  1.  I $D(AGDOG) D  G VAR
  1.  . W !!,"This patient is already registered at this facility!"
  1.  . K DIR
  1.  . S DIR(0)="E"
  1.  . S DIR("T")=DTIME
  1.  . D ^DIR
  1.  . K DIR
  1.  I AGOPT(14)'="N",$D(^AUPNPAT(DFN,11)),$P(^AUPNPAT(DFN,11),U,12)]"" D
  1.  . D CALCELIG^AGBIC2
  1.  . W !,"This patient's eligibility is ",$P(AG("NARR1"),":",2)
  1.  K DIR
  1.  S DIR(0)="Y"
  1.  S DIR("B")="NO"
  1.  S DIR("A")="Do you wish to edit "_$P(^DPT(DFN,0),U)_" (Y/N) "
  1.  S DIR("T")=DTIME
  1.  D ^DIR
  1.  G VAR:Y="^"
  1.  G END:$D(DTOUT)!(Y="/.,")!(Y="^^")
  1.  G L0D:Y=0!(Y="")
  1.  G:Y=1 ^AGED1
  1.  G L0
  1. L0A ;
  1.  K DIR
  1.  S DIR(0)="Y"
  1.  S DIR("B")="YES"
  1.  S DIR("A")="Do you wish to register "_$P(^DPT(DFN,0),U)_" at "_$P(^DIC(4,DUZ(2),0),U)_" (Y/N) "
  1.  S DIR("T")=DTIME
  1.  D ^DIR
  1.  S AG("NEWREG")=""
  1.  G R2:Y="^"
  1.  G END:$D(DTOUT)!(Y="/.,")!(Y="^^")
  1.  I Y=1!(Y="") D  G CHART1^AGMAN
  1.  . S AGPTPG=0
  1.  G VAR:Y=0
  1.  G L0A
  1. L0C ;
  1.  I $D(AGDOG) W !!,"This patient is already registered at this facility but is inactive!" W !,"Refer to Medical Records for Reactivation" D READ^AG G VAR
  1.  W !!,"""",$P(^DPT(DFN,0),U),""" is filed as """,$S($P(^AUPNPAT(DFN,41,DUZ(2),0),U,5)="D":"DELETED",1:"INACTIVE"),""".",!!,"Do you wish to RE-ACTIVATE this patient's file? (Y/N) NO// " D READ^AG
  1.  G END:$D(DFOUT)!$D(DTOUT),VAR:$D(DUOUT)!(Y["N")!$D(DLOUT) S AG("EDIT")="" G C1^AGACT:Y["Y" D YN^AG G L0C
  1. L0D ;
  1.  K DFN,AG("EDIT")
  1. L1 ;EP
  1.  W !,"Enter the NEW PATIENT'S FULL NAME....."
  1.  W !,"   (EXAMPLE:   MORGAN,JAMES PAUL,JR  (no space after commas))"
  1.  W !!,"Entering NEW Patient for ",$P(^DIC(4,DUZ(2),0),U),!!
  1.  W:$D(DFN) $P(^DPT(DFN,0),U),"// "
  1.  W !!
  1.  S DIC("A")="Enter the PATIENT'S NAME: "
  1.  S DIC="^AUPNPAT("
  1.  S DIC(0)="AEMLQ"
  1.  S DIADD=1
  1.  S DLAYGO=2
  1.  D SET^AUPNLKZ
  1.  D ^DIC
  1.  D RESET^AUPNLKZ
  1.  K DIADD,DLAYGO,DIC
  1.  I $D(DUOUT)!($D(DTOUT))!(X="") G END
  1.  G:Y=-1 L1
  1.  S DFN=+Y
  1.  S AGPATDFN=DFN              ;PHASE OUT USE OF DFN TO AVOID CHANGES WHEN CALLING DIC
  1.  ;ADD LOCK SO PATIENT BEING EDITED CANNOT BE EDITED BY ANOTHER USER
  1.  L +^AUPNPAT(DFN):5 I '$T W !,"Patient's record already in use! Try again later!" Q
  1.  ;L +^DPT(DFN):5 I '$T W !,"Patient's record already in use! Try again later!" Q  ;AG*7.1*2
  1.  D NOW^%DTC
  1.  S AGDTS=%
  1.  S ^AGPATCH(AGDTS,DUZ(2),DFN)="NEW"
  1.  S $P(^AUPNPAT(DFN,0),U,11)=DUZ ; hard set is necessary as data item is uneditable per file definition
  1.  K AG("EDIT")
  1.  G ^AG2:AGOPT(14)="N"      ;ELIGIBILITY AND TRIBAL DATA
  1.  G ^AGBIC2:AGOPT(14)="Y"   ;MANDATORY DATA
  1.  G ^AGBIC2P:AGOPT(14)="C"  ;MANDATORY DATA 2
  1.  ;
  1. L11 ;EP
  1.  I '$D(AGPAT) S AGPAT=$P(^DPT(DFN,0),U)
  1.  S AG("NPPADD")=""
  1. NPPLOOP ;
  1.  D NPP^AGED11A
  1.  D ACK^AGED11A
  1.  D RHI^AGED11A
  1. ETHNIC ;ENTER ETHNICITY
  1.  D ETHNIC^AGED10B  ;AG*7.1*7/AG*7.1*8 - Changed to AGED10B
  1. RACE ; ENTER RACE, NUMBER IN HOUSEHOLD, TOTAL HOUSEHOLD INCOME
  1.  D RACE^AGED10B ;AG*7.1*10 - Moved Race outside of check below
  1.  I AGOPT(22)="Y"  D
  1.  . D NIH^AGED10B ;AG*7.1*8 - Changed to AGED10B
  1.  . D THI^AGED10B ;AG*7.1*8 - Changed to AGED10B
  1.  ;
  1.  L -^AUPNPAT(DFN)
  1.  ;L -^DPT(DFN)  ;AG*7.1*2
  1.  W !!!,"This concludes the NEW PATIENT ENTRY PROCESS for this patient."
  1.  H 2
  1.  ;
  1.  ;BEGIN **MPI** ADD PATIENT TO MPI AG*7.2 IHS/SD/TPF 5/6/2010  ;MAYBE USE THE VTQ AS A QUERY 'SEEDER'
  1.  ;D CREATMSG^AGMPIHLO(DFN,"VTQ",,.SUCCESS)   ;IF SUCCESSFUL THEN MPI ICN HAS BEEN ADDED TO THE PATIENTS FILE
  1.  ;I 'SUCCESS D
  1.  ;.S AGERROR="MPI DFN="_DFN_" :: "_"ERROR WHEN CREATING VTQ EXACT MATCH QUERY"
  1.  ;.D NOTIF^AGMPIHLO(DFN,AGERROR)
  1.  N X,SUCCESS,DIC,INDA
  1.  S X="AGMPIHLO" X ^%ZOSF("TEST") I $T D
  1.  .D CREATMSG^AGMPIHLO(DFN,"A28",,.SUCCESS)
  1.  .W !!,"A request to add this patient has been sent to the MPI" H 2
  1.  .I 'SUCCESS D NOTIF^AGMPIHLO(DFN,"Unable to create A28 to add patient to MPI from AGMPHLVQ")
  1.  .S X="AG REGISTER A PATIENT",DIC=101,INDA=DFN
  1.  .D EN^XQOR
  1.  ;END **MPI**
  1.  ;
  1.  ;BEGIN NEW CODE IHS/SD/TPF 5/2/2006 AG*7.1*2 PAGE 12 ITEM 3
  1.  I $$AGE^AGUTILS(AGPATDFN)<3 D AUTOADD^BIPATE(AGPATDFN,DUZ(2),.AGERR,"")
  1.  ;END NEW CODE
  1.  ;HL7 INTERFACE -- PUT PATIENT DFN INTO TEMP ARRAY FOR HL7 CALL
  1.  S ^XTMP("AGHL7",DUZ(2),DFN)=DFN  ;AG*7.1*9 - Added DUZ(2) subscript
  1.  S ^XTMP("AGHL7AG",DUZ(2),DFN,"REGISTER")=""  ;AG*7.1*9 - Added DUZ(2) subscript
  1.  Q
  1. END ;
  1.  G K:$D(AG("EDIT"))
  1.  K AG,AGT,AGDTS
  1.  Q
  1. K ;EP
  1.  W !!,*7,"The '",$P(^DPT(DFN,0),U),"' file is deleted."
  1.  D Z1^AGKPAT
  1.  D DFN^AGKPAT
  1.  G END