AGMBIR2 ;IHS/OIT/NKD - PAT REG MBI EDIT ; JULY 23, 2018
;;7.1;PATIENT REGISTRATION;**14**;AUG 25, 2005;Build 1
;
;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
;
PAT ; PATIENT LOOKUP
N DFN,RHIFLAG,REC,AGPATDFN
D PTLK^AG
Q:'$D(DFN)!$D(DUOUT)!$D(DFOUT)!$D(DTOUT)!$D(DIRUT)
PRINT ; PRINT DETAILS
N AGRES
S AGRES=$$GETMBIS^AGUTL(DFN,"AGRES")
S AGRES=$G(AGRES)
I 'AGRES W !!,"Patient has no MBI history on file."
E D
. W !!,?10,"Eff Date",?26,"MBI",?40,"Source"
. N CNT S CNT=0 F S CNT=$O(AGRES(CNT)) Q:'CNT D
. . W !,$$RJ^XLFSTR(CNT_")",6),?10,$P(AGRES(CNT,0),U,2),?26,$P(AGRES(CNT,0),U,3),?40,$P(AGRES(CNT,0),U,4)
ASK ; PROMPT FOR ACTION
W !
N AGANS K DIR
S DIR("A")="ENTER ACTION (<A>dd MBI,<E>dit MBI,<D>elete MBI): "
S DIR(0)="SAO^A:ADD;E:EDIT;D:DELETE"
D ^DIR
I $D(DUOUT)!$D(DFOUT)!$D(DTOUT)!$D(DIRUT) D END Q
S AGANS=$G(Y)
I AGANS="A" D ADD
E I AGANS="E" D EDIT(.AGRES)
E I AGANS="D" D DELETE(.AGRES)
G PRINT
Q
ADD ; ADD MBI
N POL
; INTERACTIVE ENTRY PROMPT
K DIR
S DIR(0)="FA^11"
S DIR("A")="MBI: "
D ^DIR
Q:$D(DUOUT)!$D(DFOUT)!$D(DTOUT)!$D(DIRUT)
S POL=$$ASKMBI^AGUTL(DFN,$G(X),"OTH") ;MBI FORMAT
Q
EDIT(AGRES) ; EDIT MBI
N POL,AGENTRY,MBI,RES,SRC S AGRES=$G(AGRES)
; INTERACTIVE ENTRY PROMPT
K DIR
S DIR(0)="NA^1:"_$G(AGRES)
S DIR("A")="SELECT ENTRY (1-"_$G(AGRES)_"): "
D ^DIR
Q:$D(DUOUT)!$D(DFOUT)!$D(DTOUT)!$D(DIRUT)
S AGENTRY=$G(Y)
; INTERACTIVE MBI PROMPT
K DIR
S DIR(0)="FA^11"
S DIR("A")="MBI: "
S DIR("B")=$P(AGRES(AGENTRY,0),U,3)
D ^DIR
Q:$D(DUOUT)!$D(DFOUT)!$D(DTOUT)!$D(DIRUT)
S MBI=$G(Y)
; VALIDATE MBI FORMAT
K DIR
S RES=$$FORMOK^AUPNMBI(MBI)
I 'RES W !,$P(RES,U,2),! S DIR(0)="9000001.44,1",DIR("B")=MBI D ^DIR S MBI=$G(Y)
Q:$D(DUOUT)!$D(DFOUT)!$D(DTOUT)!$D(DIRUT)
; INTERACTIVE SOURCE PROMPT
K DIR
S DIR(0)="9000001.44,2",DIR("B")=$P(AGRES(AGENTRY,0),U,4) D ^DIR
Q:$D(DUOUT)!$D(DFOUT)!$D(DTOUT)!$D(DIRUT)
S SRC=$G(Y)
; CALL AUPN MBI
S RES=$$ADDMBI^AUPNMBI(DFN,$P(AGRES(AGENTRY,0),U,1),MBI,SRC)
Q
DELETE(AGRES) ; DELETE MBI
N AGENTRY,RES S AGRES=$G(AGRES)
; INTERACTIVE ENTRY PROMPT
K DIR
S DIR(0)="NA^1:"_$G(AGRES)
S DIR("A")="SELECT ENTRY (1-"_$G(AGRES)_"): "
D ^DIR
Q:$D(DUOUT)!$D(DFOUT)!$D(DTOUT)!$D(DIRUT)
S AGENTRY=$G(Y)
; CALL AUPN MBI
S RES=$$DELMBI^AUPNMBI(DFN,$P(AGRES(AGENTRY,0),U,1),$P(AGRES(AGENTRY,0),U,3))
Q
END ; CLEANUP
K DIR
S DIR("A")="Press RETURN..."
S DIR(0)="E"
D ^DIR
K DIR
D ^XBFMK,KILL^AUPNPAT
Q
AGMBIR2 ;IHS/OIT/NKD - PAT REG MBI EDIT ; JULY 23, 2018
+1 ;;7.1;PATIENT REGISTRATION;**14**;AUG 25, 2005;Build 1
+2 ;
+3 ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
+4 ;
PAT ; PATIENT LOOKUP
+1 NEW DFN,RHIFLAG,REC,AGPATDFN
+2 DO PTLK^AG
+3 IF '$DATA(DFN)!$DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)!$DATA(DIRUT)
QUIT
PRINT ; PRINT DETAILS
+1 NEW AGRES
+2 SET AGRES=$$GETMBIS^AGUTL(DFN,"AGRES")
+3 SET AGRES=$GET(AGRES)
+4 IF 'AGRES
WRITE !!,"Patient has no MBI history on file."
+5 IF '$TEST
Begin DoDot:1
+6 WRITE !!,?10,"Eff Date",?26,"MBI",?40,"Source"
+7 NEW CNT
SET CNT=0
FOR
SET CNT=$ORDER(AGRES(CNT))
IF 'CNT
QUIT
Begin DoDot:2
+8 WRITE !,$$RJ^XLFSTR(CNT_")",6),?10,$PIECE(AGRES(CNT,0),U,2),?26,$PIECE(AGRES(CNT,0),U,3),?40,$PIECE(AGRES(CNT,0),U,4)
End DoDot:2
End DoDot:1
ASK ; PROMPT FOR ACTION
+1 WRITE !
+2 NEW AGANS
KILL DIR
+3 SET DIR("A")="ENTER ACTION (<A>dd MBI,<E>dit MBI,<D>elete MBI): "
+4 SET DIR(0)="SAO^A:ADD;E:EDIT;D:DELETE"
+5 DO ^DIR
+6 IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)!$DATA(DIRUT)
DO END
QUIT
+7 SET AGANS=$GET(Y)
+8 IF AGANS="A"
DO ADD
+9 IF '$TEST
IF AGANS="E"
DO EDIT(.AGRES)
+10 IF '$TEST
IF AGANS="D"
DO DELETE(.AGRES)
+11 GOTO PRINT
+12 QUIT
ADD ; ADD MBI
+1 NEW POL
+2 ; INTERACTIVE ENTRY PROMPT
+3 KILL DIR
+4 SET DIR(0)="FA^11"
+5 SET DIR("A")="MBI: "
+6 DO ^DIR
+7 IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)!$DATA(DIRUT)
QUIT
+8 ;MBI FORMAT
SET POL=$$ASKMBI^AGUTL(DFN,$GET(X),"OTH")
+9 QUIT
EDIT(AGRES) ; EDIT MBI
+1 NEW POL,AGENTRY,MBI,RES,SRC
SET AGRES=$GET(AGRES)
+2 ; INTERACTIVE ENTRY PROMPT
+3 KILL DIR
+4 SET DIR(0)="NA^1:"_$GET(AGRES)
+5 SET DIR("A")="SELECT ENTRY (1-"_$GET(AGRES)_"): "
+6 DO ^DIR
+7 IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)!$DATA(DIRUT)
QUIT
+8 SET AGENTRY=$GET(Y)
+9 ; INTERACTIVE MBI PROMPT
+10 KILL DIR
+11 SET DIR(0)="FA^11"
+12 SET DIR("A")="MBI: "
+13 SET DIR("B")=$PIECE(AGRES(AGENTRY,0),U,3)
+14 DO ^DIR
+15 IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)!$DATA(DIRUT)
QUIT
+16 SET MBI=$GET(Y)
+17 ; VALIDATE MBI FORMAT
+18 KILL DIR
+19 SET RES=$$FORMOK^AUPNMBI(MBI)
+20 IF 'RES
WRITE !,$PIECE(RES,U,2),!
SET DIR(0)="9000001.44,1"
SET DIR("B")=MBI
DO ^DIR
SET MBI=$GET(Y)
+21 IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)!$DATA(DIRUT)
QUIT
+22 ; INTERACTIVE SOURCE PROMPT
+23 KILL DIR
+24 SET DIR(0)="9000001.44,2"
SET DIR("B")=$PIECE(AGRES(AGENTRY,0),U,4)
DO ^DIR
+25 IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)!$DATA(DIRUT)
QUIT
+26 SET SRC=$GET(Y)
+27 ; CALL AUPN MBI
+28 SET RES=$$ADDMBI^AUPNMBI(DFN,$PIECE(AGRES(AGENTRY,0),U,1),MBI,SRC)
+29 QUIT
DELETE(AGRES) ; DELETE MBI
+1 NEW AGENTRY,RES
SET AGRES=$GET(AGRES)
+2 ; INTERACTIVE ENTRY PROMPT
+3 KILL DIR
+4 SET DIR(0)="NA^1:"_$GET(AGRES)
+5 SET DIR("A")="SELECT ENTRY (1-"_$GET(AGRES)_"): "
+6 DO ^DIR
+7 IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)!$DATA(DIRUT)
QUIT
+8 SET AGENTRY=$GET(Y)
+9 ; CALL AUPN MBI
+10 SET RES=$$DELMBI^AUPNMBI(DFN,$PIECE(AGRES(AGENTRY,0),U,1),$PIECE(AGRES(AGENTRY,0),U,3))
+11 QUIT
END ; CLEANUP
+1 KILL DIR
+2 SET DIR("A")="Press RETURN..."
+3 SET DIR(0)="E"
+4 DO ^DIR
+5 KILL DIR
+6 DO ^XBFMK
DO KILL^AUPNPAT
+7 QUIT
