AZXAADD ; IHS/PHXAO/TMJ - ADD A NEW DISCLOSURE DATE ;
;;2.0;RELEASE OF INFORMATION;;FEB 21, 2002
;
; Subscripted AZXAREC is EXTERNAL form.
; AZXAREC("PAT NAME")=patient name
; AZXAREC("REF DATE")=disclosure date
; AZXADFN=patient ien
; AZXARDATE=disclosure date in internal FileMan form
; AZXARNUMB=disclosure number
; AZXARIEN=Disclosure ien
; AZXAMODE=A for add, M for modify
; AZXARTYPE=type of disclousre (.04 field)
;
START ;
F D MAIN Q:AZXAQ D HDR^AZXA
D EOJ
Q
;
MAIN ;
S AZXAQ=0
S AZXAMODE="A",AZXALOOK=""
;S APCDOVRR="" ;for provider narrative lookup
D PATIENT ; get patient being referred
Q:AZXAQ
D REFDISP
I AZXAQ=1 G GETDATE
;
D ASK
Q:AZXAQ
;
GETDATE ;Do Get Date if no existing Disclosures
D DATE ; get date of Disclosure
Q:AZXAQ
D ADD ; add new Disclosure record
Q:AZXAQ
D EDIT ; edit Disclosure record just added
Q
;
PATIENT ; GET PATIENT
F D PATIENT2 I AZXAQ!($G(AZXADFN)) Q
Q
;
PATIENT2 ; ASK FOR PATIENT UNTIL USER SELECTS OR QUITS
S AZXAQ=1
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D DIC^AZXAFMC
Q:Y<1
S AZXADFN=+Y,AZXAREC("PAT NAME")=$P(^DPT(+Y,0),U)
S AZXAQ=0
I $$DOD^AUPNPAT(AZXADFN) D I 'Y K AZXADFN,AZXAREC("PAT NAME") Q
. W !!,"This patient is deceased."
. S DIR(0)="YO",DIR("A")="Are you sure you want this patient",DIR("B")="NO" K DA D ^DIR K DIR
. W !
. Q
Q
;
;
ASK ;Ask to Continue
S AZXAQ=0
W !! S DIR(0)="Y",DIR("A")="Do you want to continue with adding a new Disclosure",DIR("B")="Y" K DA D ^DIR K DIR
I $D(DIRUT) S AZXAQ=1 Q
I 'Y S AZXAQ=1 Q
Q
;
REFDISP ;Display if Patient has existing Disclosures
W !!,?25,"********************",!
W ?25,"**LAST 4 DISCLOSURES**",!,?25,"********************",!
I '$D(^AZXAREC("AA",AZXADFN)) W !,?20,"**--NO EXISTING DISCLOSURES--**",! S AZXAQ=1 Q
S AZXAQ=0
S AZXADT=""
F I=1:1:5 S AZXADT=$O(^AZXAREC("AA",AZXADFN,AZXADT),-1) Q:AZXADT="" D NEXT
Q
NEXT ;2ND $O
S AZXARIEN=""
F S AZXARIEN=$O(^AZXAREC("AA",AZXADFN,AZXADT,AZXARIEN),-1) Q:AZXARIEN'=+AZXARIEN D
. Q:AZXADT=""
. Q:AZXARIEN=""
. D START^AZXALKI1
. S I=I+1 ; increment outer loop counter to limit display to 4 Disclosures
. Q
Q
;
;
;
DATE ; GET DATE OF DISCLOSURE
W !
S AZXAQ=1
;
S DIR(0)="1991075,.01",DIR("B")="TODAY" K DA D ^DIR K DIR
Q:$D(DIRUT)
S AZXARDATE=+Y,AZXAREC("REF DATE")=Y(0)
S AZXAQ=0
Q
;
ADD ; ADD NEW DISCLOSURE RECORD
S AZXARR=""
Q:AZXAQ
I AZXARR="" D Q
.S DIC="^AZXAREC(",DIC(0)="L",DLAYGO=1991075,DIC("DR")=".03////"_AZXADFN,X=AZXARDATE
.D FILE^AZXAFMC
.I Y<0 W !,"Error creating DISCLOSURE.",!,"Notify programmer.",! D EOP^AZXA Q
.;
.S AZXARIEN=+Y
. W !!,"DISCLOSURE NUMBER: ",$$VAL^XBDIQ1(1991075,AZXARIEN,.02)
.S AZXAQ=0
.Q
EDIT ; EDIT REFERRAL RECORD JUST ADDED
S DIE="^AZXAREC(",DA=AZXARIEN,DR="[AZXA JCK BRANCH]",DIE("NO^")=1 D ^DIE K DA,DR,DIE,DIE("NO^")
;
RECVAR ;Get Record Variables
;
S Y=AZXARIEN
D ^AZXAREF ; set standard variables from record
Q
;
DELETE ; DELETE REFERRAL JUST ADDED BECAUSE OPERATOR DIDN'T FINISH
W !!,"INCOMPLETE DISCLOSURE BEING DELETED!",!!
S DIK="^AZXAREC(",DA=AZXARIEN D ^DIK
D PAUSE^AZXA
Q
;
;
EOJ ; END OF JOB
D ^AZXAKILL
Q
AZXAADD ; IHS/PHXAO/TMJ - ADD A NEW DISCLOSURE DATE ;
+1 ;;2.0;RELEASE OF INFORMATION;;FEB 21, 2002
+2 ;
+3 ; Subscripted AZXAREC is EXTERNAL form.
+4 ; AZXAREC("PAT NAME")=patient name
+5 ; AZXAREC("REF DATE")=disclosure date
+6 ; AZXADFN=patient ien
+7 ; AZXARDATE=disclosure date in internal FileMan form
+8 ; AZXARNUMB=disclosure number
+9 ; AZXARIEN=Disclosure ien
+10 ; AZXAMODE=A for add, M for modify
+11 ; AZXARTYPE=type of disclousre (.04 field)
+12 ;
START ;
+1 FOR
DO MAIN
IF AZXAQ
QUIT
DO HDR^AZXA
+2 DO EOJ
+3 QUIT
+4 ;
MAIN ;
+1 SET AZXAQ=0
+2 SET AZXAMODE="A"
SET AZXALOOK=""
+3 ;S APCDOVRR="" ;for provider narrative lookup
+4 ; get patient being referred
DO PATIENT
+5 IF AZXAQ
QUIT
+6 DO REFDISP
+7 IF AZXAQ=1
GOTO GETDATE
+8 ;
+9 DO ASK
+10 IF AZXAQ
QUIT
+11 ;
GETDATE ;Do Get Date if no existing Disclosures
+1 ; get date of Disclosure
DO DATE
+2 IF AZXAQ
QUIT
+3 ; add new Disclosure record
DO ADD
+4 IF AZXAQ
QUIT
+5 ; edit Disclosure record just added
DO EDIT
+6 QUIT
+7 ;
PATIENT ; GET PATIENT
+1 FOR
DO PATIENT2
IF AZXAQ!($GET(AZXADFN))
QUIT
+2 QUIT
+3 ;
PATIENT2 ; ASK FOR PATIENT UNTIL USER SELECTS OR QUITS
+1 SET AZXAQ=1
+2 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO DIC^AZXAFMC
+3 IF Y<1
QUIT
+4 SET AZXADFN=+Y
SET AZXAREC("PAT NAME")=$PIECE(^DPT(+Y,0),U)
+5 SET AZXAQ=0
+6 IF $$DOD^AUPNPAT(AZXADFN)
Begin DoDot:1
+7 WRITE !!,"This patient is deceased."
+8 SET DIR(0)="YO"
SET DIR("A")="Are you sure you want this patient"
SET DIR("B")="NO"
KILL DA
DO ^DIR
KILL DIR
+9 WRITE !
+10 QUIT
End DoDot:1
IF 'Y
KILL AZXADFN,AZXAREC("PAT NAME")
QUIT
+11 QUIT
+12 ;
+13 ;
ASK ;Ask to Continue
+1 SET AZXAQ=0
+2 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue with adding a new Disclosure"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET AZXAQ=1
QUIT
+4 IF 'Y
SET AZXAQ=1
QUIT
+5 QUIT
+6 ;
REFDISP ;Display if Patient has existing Disclosures
+1 WRITE !!,?25,"********************",!
+2 WRITE ?25,"**LAST 4 DISCLOSURES**",!,?25,"********************",!
+3 IF '$DATA(^AZXAREC("AA",AZXADFN))
WRITE !,?20,"**--NO EXISTING DISCLOSURES--**",!
SET AZXAQ=1
QUIT
+4 SET AZXAQ=0
+5 SET AZXADT=""
+6 FOR I=1:1:5
SET AZXADT=$ORDER(^AZXAREC("AA",AZXADFN,AZXADT),-1)
IF AZXADT=""
QUIT
DO NEXT
+7 QUIT
NEXT ;2ND $O
+1 SET AZXARIEN=""
+2 FOR
SET AZXARIEN=$ORDER(^AZXAREC("AA",AZXADFN,AZXADT,AZXARIEN),-1)
IF AZXARIEN'=+AZXARIEN
QUIT
Begin DoDot:1
+3 IF AZXADT=""
QUIT
+4 IF AZXARIEN=""
QUIT
+5 DO START^AZXALKI1
+6 ; increment outer loop counter to limit display to 4 Disclosures
SET I=I+1
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
+10 ;
+11 ;
DATE ; GET DATE OF DISCLOSURE
+1 WRITE !
+2 SET AZXAQ=1
+3 ;
+4 SET DIR(0)="1991075,.01"
SET DIR("B")="TODAY"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
QUIT
+6 SET AZXARDATE=+Y
SET AZXAREC("REF DATE")=Y(0)
+7 SET AZXAQ=0
+8 QUIT
+9 ;
ADD ; ADD NEW DISCLOSURE RECORD
+1 SET AZXARR=""
+2 IF AZXAQ
QUIT
+3 IF AZXARR=""
Begin DoDot:1
+4 SET DIC="^AZXAREC("
SET DIC(0)="L"
SET DLAYGO=1991075
SET DIC("DR")=".03////"_AZXADFN
SET X=AZXARDATE
+5 DO FILE^AZXAFMC
+6 IF Y<0
WRITE !,"Error creating DISCLOSURE.",!,"Notify programmer.",!
DO EOP^AZXA
QUIT
+7 ;
+8 SET AZXARIEN=+Y
+9 WRITE !!,"DISCLOSURE NUMBER: ",$$VAL^XBDIQ1(1991075,AZXARIEN,.02)
+10 SET AZXAQ=0
+11 QUIT
End DoDot:1
QUIT
EDIT ; EDIT REFERRAL RECORD JUST ADDED
+1 SET DIE="^AZXAREC("
SET DA=AZXARIEN
SET DR="[AZXA JCK BRANCH]"
SET DIE("NO^")=1
DO ^DIE
KILL DA,DR,DIE,DIE("NO^")
+2 ;
RECVAR ;Get Record Variables
+1 ;
+2 SET Y=AZXARIEN
+3 ; set standard variables from record
DO ^AZXAREF
+4 QUIT
+5 ;
DELETE ; DELETE REFERRAL JUST ADDED BECAUSE OPERATOR DIDN'T FINISH
+1 WRITE !!,"INCOMPLETE DISCLOSURE BEING DELETED!",!!
+2 SET DIK="^AZXAREC("
SET DA=AZXARIEN
DO ^DIK
+3 DO PAUSE^AZXA
+4 QUIT
+5 ;
+6 ;
EOJ ; END OF JOB
+1 DO ^AZXAKILL
+2 QUIT
