| 1 | AUPNLK2 ; IHS/CMI/LAB - IHS PATIENT LOOKUP ADD NEW PATIENT ;10/29/07 10:32
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**167**;Aug 12, 1996;Build 2
|
|---|
| 3 | ;'Modified' MAS Patient Look-up Add New Patient, June 1987
|
|---|
| 4 | ;
|
|---|
| 5 | ; Upon exiting this routine AUPDFN will be set as follows:
|
|---|
| 6 | ;
|
|---|
| 7 | ; AUPDFN >0 means patient added and AUPDFN is the DFN
|
|---|
| 8 | ; AUPDFN <0 means patient not added
|
|---|
| 9 | ;
|
|---|
| 10 | ; AUPQF2 values have the following meaning:
|
|---|
| 11 | ;
|
|---|
| 12 | ; 0 = Initial state
|
|---|
| 13 | ; 1 = Primary error
|
|---|
| 14 | ; 2 = Name edit error
|
|---|
| 15 | ; 3 = Operator said no
|
|---|
| 16 | ; 4 = Identifier failure
|
|---|
| 17 | ; 5 = No add from dupe checker
|
|---|
| 18 | ; 6 = Add failed
|
|---|
| 19 | ;
|
|---|
| 20 | START ;
|
|---|
| 21 | D INIT ; Initialization
|
|---|
| 22 | I AUPQF2 D EOJ Q
|
|---|
| 23 | D EDIT ; Edit the name
|
|---|
| 24 | I AUPQF2 D EOJ Q
|
|---|
| 25 | K AUPLID
|
|---|
| 26 | I DIC(0)["E" D TALK ; Ask if add, get identifiers, check dupes
|
|---|
| 27 | I AUPQF2 D EOJ Q
|
|---|
| 28 | D ADDPAT ; Add patient
|
|---|
| 29 | I AUPQF2 D EOJ Q
|
|---|
| 30 | D EOJ
|
|---|
| 31 | Q
|
|---|
| 32 | ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|---|
| 33 | ;
|
|---|
| 34 | EDIT ; EXTERNAL ENTRY POINT - EDIT NAME
|
|---|
| 35 | S X=AUPX
|
|---|
| 36 | X $P(^DD(2,.01,0),U,5,99)
|
|---|
| 37 | I '$D(X) S AUPQF2=2 W:DIC(0)["Q" *7," ??" Q
|
|---|
| 38 | Q
|
|---|
| 39 | ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|---|
| 40 | ;
|
|---|
| 41 | TALK ; EXTERNAL ENTERY POINT - TALK TO OPERATOR
|
|---|
| 42 | D ^AUPNLK2B
|
|---|
| 43 | Q
|
|---|
| 44 | ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|---|
| 45 | ;
|
|---|
| 46 | ADDPAT ; ADD PATIENT
|
|---|
| 47 | I $D(AUPLID),DIC(0)["E" W !!?3,"Please enter the following additional information:",!?3
|
|---|
| 48 | K DD,DO S X=AUPX S:$D(AUP("DR")) DIC("DR")=AUP("DR") D FILE^DICN S DIC("W")=AUPDICW K:$D(AUP("DR")) DIC("DR") S AUPDFN=Y
|
|---|
| 49 | I +AUPDFN>0 L +^DPT(+AUPDFN):10 D IHSPAT L -^DPT(+AUPDFN) Q:AUPQF2
|
|---|
| 50 | Q:$T(GOTIDQ^DGLBPID)=""
|
|---|
| 51 | N DFN S DFN=+AUPDFN
|
|---|
| 52 | Q:$$GOTIDQ^DGLBPID(DFN)
|
|---|
| 53 | I $$REQID^DGLBPID(DFN)="HRN" D
|
|---|
| 54 | .D HRN^MPIFAG1
|
|---|
| 55 | I $$REQID^DGLBPID(DFN)="SSN" D
|
|---|
| 56 | .N DIE,DR,DA S DA=DFN,DIE=2,DR=.09 D ^DIE
|
|---|
| 57 | I '$$GOTIDQ^DGLBPID(DFN) D S AUPQF2=6
|
|---|
| 58 | .N DA,DIK,DIC S DIK="^DPT(",DA=DFN D ^DIK W !,"PATIENT DELETED BECAUSE YOU DIDN'T ENTER ",$$REQID^DGLBPID(DFN),!!
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | ;
|
|---|
| 62 | ;
|
|---|
| 63 | ;
|
|---|
| 64 | IHSPAT ; ADD PATIENT TO 9000001
|
|---|
| 65 | K DD,D0
|
|---|
| 66 | F AUPV="DINUM","DIC","DIC(""DR"")","DIC(0)","DLAYGO" S:$D(@AUPV) AUPRCR(AUPV)=@AUPV
|
|---|
| 67 | S (Y,X)=+AUPDFN,DINUM=X,DIC="^AUPNPAT(",DIC(0)="L",DLAYGO=9000001,DIC("DR")=".02////"_DT_";.11////"_DUZ D:'$D(^AUPNPAT(X)) FILE^DICN L +^DPT(+AUPDFN):10 S DIC("W")=AUPDICW I Y<0 D IHSPATE
|
|---|
| 68 | K DINUM,DIC("DR"),DIC(0),DLAYGO S AUPV="" F AUPL=0:0 S AUPV=$O(AUPRCR(AUPV)) Q:AUPV="" S @AUPV=AUPRCR(AUPV)
|
|---|
| 69 | K AUPRCR,AUPV
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | IHSPATE ; ERROR ADDING TO 9000001
|
|---|
| 73 | W:AUPRCR("DIC(0)")["Q" !!?3,"Adding patient to ^AUPNPAT failed. Patient being removed from ^DPT also.",!
|
|---|
| 74 | S DA=+AUPDFN,DIK="^DPT(" D ^DIK K DA,DIK
|
|---|
| 75 | S AUPQF2=6
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|---|
| 79 | ;
|
|---|
| 80 | INIT ; EXTERNAL ENTRY POINT - INITIALIZATION
|
|---|
| 81 | S AUPQF2=0
|
|---|
| 82 | I '$D(DUZ(0)) W:DIC(0)["Q" !?3,*7,"Unable to Add Patient. Your Fileman Access Code is undefined." S AUPQF2=1 Q
|
|---|
| 83 | D ACCESS K I,X
|
|---|
| 84 | Q:AUPQF2
|
|---|
| 85 | S:'($D(DUZ)#2) DUZ=0 S:DUZ="" DUZ=0
|
|---|
| 86 | ; Next line edited to remove reference to file #3; RED
|
|---|
| 87 | I '$D(^VA(200,DUZ)) W:DIC(0)["Q" !?3,*7,"Unable to Add Patient. DUZ is not a valid user." S AUPQF2=1 Q
|
|---|
| 88 | Q
|
|---|
| 89 | ;
|
|---|
| 90 | ACCESS ; CHECK FILEMAN ACCESS
|
|---|
| 91 | S X=$S(AUPDIC="^DPT(":2,1:9000001)
|
|---|
| 92 | I $S($D(DLAYGO):X-DLAYGO,1:1),DUZ(0)'["@",$D(^DIC(X,0,"LAYGO")) S X=^("LAYGO") X "F I=1:1 I DUZ(0)[$E(X,I) Q" I I>$L(DUZ(0)) W:DIC(0)["Q" !?3,*7,"Unable to Add Patient. You do not have Add authority." S AUPQF2=1 Q
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|---|
| 96 | ;
|
|---|
| 97 | EOJ ; EXTERNAL ENTRY POINT
|
|---|
| 98 | S:AUPQF2 AUPDFN=-1
|
|---|
| 99 | K AUPGID,AUPID,AUPID0,AUPIDS,AUPLID,AUP("DR"),AUPQF2,AUPRCR,AUPSET,AUPV
|
|---|
| 100 | Q
|
|---|
