BDP ; IHS/CMI/TMJ - DESG SPECIALTY PROVIDER MGT SYSTEM ;
;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
;
;
I '$D(ZTQUEUED) W !!,*7,"NO ENTRY FROM THE TOP OF ^BDP.",!
S BDPQ=1
Q
;----------
LZERO(V,L) ;left zero fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V="0"_V
Q V
;----------
ASF() ;EP - Return ASUFAC number for current DUZ(2).
Q:'$G(DUZ(2)) ""
Q $P($G(^AUTTLOC(DUZ(2),0)),U,10)
;----------
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
DIC(DIC) ;EP - File lookup.
S:'$D(DIC(0)) DIC(0)="AMQN"
D DIC^BDPFMC
Q +Y
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR(0)="E" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
HDR ;EP - Screen header
Q:$G(XQY0)=""
I '$D(IORVON) S X="IORVON;IORVOFF" D ENDR^%ZISS
S X=$P(XQY0,U,2)
S:X="Designated Specialty Provider Management System" X="MAIN MENU"
S X=$J("",2*$L(IORVON)-1)_IORVON_X_IORVOFF
;I X="Designated Specialty Provider Management System" S X="MAIN MENU"
W @IOF,!,$$CTR("DESIGNATED SPECIALTY PROVIDER MANAGEMENT SYSTEM"),!,$$CTR($$LOC()),!,$$CTR(X),!!
Q
;----------
LOCK(DA) ;EP - Lock the selected Record.
LOCK +^BDPRECN(DA):20
E W:'$D(ZTQUEUED) *7,!!," This Document Is Currently Being Processed (Document LOCKED).",!! D EOP I 0
Q
;----------
UNLOCK(DA) ;EP - Unlock the selected record.
LOCK -^BDPRECN(DA):20
E W:'$D(ZTQUEUED) *7,!!," UNABLE TO UNLOCK RECORD. NOTIFY PROGRAMMER.",!! D EOP I 0
Q
;----------
LOGO ;EP - Print logo of main menu.
NEW A,D,I,L,N,R,V
S L=18,R=61,D=R-L+1,N=R-L-1
S I=$O(^DIC(9.4,"C","BDP",0)),V=^DIC(9.4,I,"VERSION"),A=$O(^DIC(9.4,I,22,"B",V,0)),Y=$$FMTE^XLFDT($P(^DIC(9.4,I,22,A,0),U,2))
W @IOF,!,$$CTR($$REPEAT^XLFSTR("*",D)),!?L,"*",$$CTR("INDIAN HEALTH SERVICE",N),?R,"*",!?L,"*",$$CTR("DESIGNATED SPECIALTY PROVIDER MGT SYSTEM",N),?R,"*",!?L,"*",$$CTR("VERSION "_V_", "_Y,N),?R,"*",!,$$CTR($$REPEAT^XLFSTR("*",D)),!
W $$CTR($$LOC())
;Sub Menu Displays
Q:$G(XQY0)=""
I '$D(IORVON) S X="IORVON;IORVOFF" D ENDR^%ZISS
S X=$P(XQY0,U,2)
S:X="Designated Specialty Provider Management System" X="MAIN MENU"
S X=$J("",2*$L(IORVON)-1)_IORVON_X_IORVOFF
W !,$$CTR(X),!
Q
;----------
DEV ; EP - SELECT OUTPUT DEVICE
S BDPQ=0
S %ZIS="PQ" D ^%ZIS
S:POP BDPQ=1
Q
;----------
PAUSE ; EP - PAUSE FOR USER
W !
S DIR(0)="EO",DIR("A")="Press ENTER...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
W !
Q
;----------
CONF ; EP - CONFIDENTIAL CLIENT DATA HEADER
W !,$$CTR("*** CONFIDENTIAL PATIENT INFORMATION ***"),!
Q
;----------
Q Y
BDP ; IHS/CMI/TMJ - DESG SPECIALTY PROVIDER MGT SYSTEM ;
+1 ;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
+2 ;
+3 ;
+4 IF '$DATA(ZTQUEUED)
WRITE !!,*7,"NO ENTRY FROM THE TOP OF ^BDP.",!
+5 SET BDPQ=1
+6 QUIT
+7 ;----------
LZERO(V,L) ;left zero fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V="0"_V
+3 QUIT V
+4 ;----------
ASF() ;EP - Return ASUFAC number for current DUZ(2).
+1 IF '$GET(DUZ(2))
QUIT ""
+2 QUIT $PIECE($GET(^AUTTLOC(DUZ(2),0)),U,10)
+3 ;----------
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
DIC(DIC) ;EP - File lookup.
+1 IF '$DATA(DIC(0))
SET DIC(0)="AMQN"
+2 DO DIC^BDPFMC
+3 QUIT +Y
+4 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
HDR ;EP - Screen header
+1 IF $GET(XQY0)=""
QUIT
+2 IF '$DATA(IORVON)
SET X="IORVON;IORVOFF"
DO ENDR^%ZISS
+3 SET X=$PIECE(XQY0,U,2)
+4 IF X="Designated Specialty Provider Management System"
SET X="MAIN MENU"
+5 SET X=$JUSTIFY("",2*$LENGTH(IORVON)-1)_IORVON_X_IORVOFF
+6 ;I X="Designated Specialty Provider Management System" S X="MAIN MENU"
+7 WRITE @IOF,!,$$CTR("DESIGNATED SPECIALTY PROVIDER MANAGEMENT SYSTEM"),!,$$CTR($$LOC()),!,$$CTR(X),!!
+8 QUIT
+9 ;----------
LOCK(DA) ;EP - Lock the selected Record.
+1 LOCK +^BDPRECN(DA):20
+2 IF '$TEST
IF '$DATA(ZTQUEUED)
WRITE *7,!!," This Document Is Currently Being Processed (Document LOCKED).",!!
DO EOP
IF 0
+3 QUIT
+4 ;----------
UNLOCK(DA) ;EP - Unlock the selected record.
+1 LOCK -^BDPRECN(DA):20
+2 IF '$TEST
IF '$DATA(ZTQUEUED)
WRITE *7,!!," UNABLE TO UNLOCK RECORD. NOTIFY PROGRAMMER.",!!
DO EOP
IF 0
+3 QUIT
+4 ;----------
LOGO ;EP - Print logo of main menu.
+1 NEW A,D,I,L,N,R,V
+2 SET L=18
SET R=61
SET D=R-L+1
SET N=R-L-1
+3 SET I=$ORDER(^DIC(9.4,"C","BDP",0))
SET V=^DIC(9.4,I,"VERSION")
SET A=$ORDER(^DIC(9.4,I,22,"B",V,0))
SET Y=$$FMTE^XLFDT($PIECE(^DIC(9.4,I,22,A,0),U,2))
+4 WRITE @IOF,!,$$CTR($$REPEAT^XLFSTR("*",D)),!?L,"*",$$CTR("INDIAN HEALTH SERVICE",N),?R,"*",!?L,"*",$$CTR("DESIGNATED SPECIALTY PROVIDER MGT SYSTEM",N),?R,"*",!?L,"*",$$CTR("VERSION "_V_", "_Y,N),?R,"*",!,$$CTR($$REPEAT^XLFSTR("*",D)),!
+5 WRITE $$CTR($$LOC())
+6 ;Sub Menu Displays
+7 IF $GET(XQY0)=""
QUIT
+8 IF '$DATA(IORVON)
SET X="IORVON;IORVOFF"
DO ENDR^%ZISS
+9 SET X=$PIECE(XQY0,U,2)
+10 IF X="Designated Specialty Provider Management System"
SET X="MAIN MENU"
+11 SET X=$JUSTIFY("",2*$LENGTH(IORVON)-1)_IORVON_X_IORVOFF
+12 WRITE !,$$CTR(X),!
+13 QUIT
+14 ;----------
DEV ; EP - SELECT OUTPUT DEVICE
+1 SET BDPQ=0
+2 SET %ZIS="PQ"
DO ^%ZIS
+3 IF POP
SET BDPQ=1
+4 QUIT
+5 ;----------
PAUSE ; EP - PAUSE FOR USER
+1 WRITE !
+2 SET DIR(0)="EO"
SET DIR("A")="Press ENTER...."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 WRITE !
+4 QUIT
+5 ;----------
CONF ; EP - CONFIDENTIAL CLIENT DATA HEADER
+1 WRITE !,$$CTR("*** CONFIDENTIAL PATIENT INFORMATION ***"),!
+2 QUIT
+3 ;----------
+4 QUIT Y
