APCDSPD ; IHS/CMI/LAB - display site parameters ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
EN1 ;
K APCDQUIT
W:$D(IOF) @IOF
W !!,"Display Patient Care Component Site Parameters",!
S DIC="^APCDSITE(",DIC(0)="AEMQ" D ^DIC K DIC I Y=-1 W !!,"Goodbye" G XIT
S APCDSITE=+Y
S DIR(0)="SO^B:BROWSE Output on Screen;P:PRINT Output to Printer",DIR("A")="Do you want to",DIR("B")="B" K DA D ^DIR K DIR
G:$D(DIRUT) XIT
I Y="B" D BROWSE,XIT Q
S XBRP="PRINT^APCDSPD",XBRC="PROC^APCDSPD",XBRX="XIT^APCDSPD",XBNS="APCD"
D ^XBDBQUE
D XIT
Q
XIT ;EP
K APCDSITE,APCDX,APCDI,APCDPG,Y
Q
BROWSE ;
D VIEWR^XBLM("PRINT^APCDSPD","Patient Care Component Site Parameter Display")
Q
PROC ;
Q
PRINT ;
S APCDPG=0
K APCDX,APCDI
W:$D(IOF) @IOF W !?15,"PATIENT CARE COMPONENT DATA ENTRY SITE PARAMETERS",!
F APCDI=.01:.01:.99 I $D(^DD(9001001.2,APCDI)) S APCDX(APCDI)=$P(^DD(9001001.2,APCDI,0),U)_U_$$VAL^XBDIQ1(9001001.2,APCDSITE,APCDI)
S X=0 F S X=$O(APCDX(X)) Q:X'=+X!($D(APCDQUIT)) D
.I $Y>(IOSL-4) D FF Q:$D(APCDQUIT)
.S L=$L($P(APCDX(X),U)) W !?(37-$S(L>37:37,1:L)),$P(APCDX(X),U),":",?40,$P(APCDX(X),U,2)
HCDB ;
K APCDX D ENPM^XBDIQ1(9001001.21101,"APCDSITE,0",".01","APCDX(")
S APCDI=0 F S APCDI=$O(APCDX(APCDI)) Q:APCDI'=+APCDI D
.I $Y>(IOSL-4) D FF Q:$D(APCDQUIT)
.W !?3,"Acceptable Patient CHART LOCATIONS: ",$G(APCDX(APCDI,.01))
.Q
MNE ;
K APCDX D ENPM^XBDIQ1(9001001.21201,APCDSITE_",0",".01","APCDX(")
S APCDI=0 F S APCDI=$O(APCDX(APCDI)) Q:APCDI'=+APCDI D
.I $Y>(IOSL-4) D FF Q:$D(APCDQUIT)
.W !?3,"Mnemonics automatically prompted for in MINI: ",$G(APCDX(APCDI,.01))
.Q
Q
FF ;
NEW X
I $E(IOST)="C" S DIR(0)="E",DIR("A")="Press 'ENTER' to continue or '^' to exit" D ^DIR K DIR I $D(DIRUT) S APCDQUIT=1
S APCDPG=APCDPG+1
W:$D(IOF) @IOF
W !?40,"PCC DATA ENTRY SITE PARAMETERS Page ",APCDPG,!!
Q
APCDSPD ; IHS/CMI/LAB - display site parameters ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
EN1 ;
+1 KILL APCDQUIT
+2 IF $DATA(IOF)
WRITE @IOF
+3 WRITE !!,"Display Patient Care Component Site Parameters",!
+4 SET DIC="^APCDSITE("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
IF Y=-1
WRITE !!,"Goodbye"
GOTO XIT
+5 SET APCDSITE=+Y
+6 SET DIR(0)="SO^B:BROWSE Output on Screen;P:PRINT Output to Printer"
SET DIR("A")="Do you want to"
SET DIR("B")="B"
KILL DA
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
GOTO XIT
+8 IF Y="B"
DO BROWSE
DO XIT
QUIT
+9 SET XBRP="PRINT^APCDSPD"
SET XBRC="PROC^APCDSPD"
SET XBRX="XIT^APCDSPD"
SET XBNS="APCD"
+10 DO ^XBDBQUE
+11 DO XIT
+12 QUIT
XIT ;EP
+1 KILL APCDSITE,APCDX,APCDI,APCDPG,Y
+2 QUIT
BROWSE ;
+1 DO VIEWR^XBLM("PRINT^APCDSPD","Patient Care Component Site Parameter Display")
+2 QUIT
PROC ;
+1 QUIT
PRINT ;
+1 SET APCDPG=0
+2 KILL APCDX,APCDI
+3 IF $DATA(IOF)
WRITE @IOF
WRITE !?15,"PATIENT CARE COMPONENT DATA ENTRY SITE PARAMETERS",!
+4 FOR APCDI=.01:.01:.99
IF $DATA(^DD(9001001.2,APCDI))
SET APCDX(APCDI)=$PIECE(^DD(9001001.2,APCDI,0),U)_U_$$VAL^XBDIQ1(9001001.2,APCDSITE,APCDI)
+5 SET X=0
FOR
SET X=$ORDER(APCDX(X))
IF X'=+X!($DATA(APCDQUIT))
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-4)
DO FF
IF $DATA(APCDQUIT)
QUIT
+7 SET L=$LENGTH($PIECE(APCDX(X),U))
WRITE !?(37-$SELECT(L>37:37,1:L)),$PIECE(APCDX(X),U),":",?40,$PIECE(APCDX(X),U,2)
End DoDot:1
HCDB ;
+1 KILL APCDX
DO ENPM^XBDIQ1(9001001.21101,"APCDSITE,0",".01","APCDX(")
+2 SET APCDI=0
FOR
SET APCDI=$ORDER(APCDX(APCDI))
IF APCDI'=+APCDI
QUIT
Begin DoDot:1
+3 IF $Y>(IOSL-4)
DO FF
IF $DATA(APCDQUIT)
QUIT
+4 WRITE !?3,"Acceptable Patient CHART LOCATIONS: ",$GET(APCDX(APCDI,.01))
+5 QUIT
End DoDot:1
MNE ;
+1 KILL APCDX
DO ENPM^XBDIQ1(9001001.21201,APCDSITE_",0",".01","APCDX(")
+2 SET APCDI=0
FOR
SET APCDI=$ORDER(APCDX(APCDI))
IF APCDI'=+APCDI
QUIT
Begin DoDot:1
+3 IF $Y>(IOSL-4)
DO FF
IF $DATA(APCDQUIT)
QUIT
+4 WRITE !?3,"Mnemonics automatically prompted for in MINI: ",$GET(APCDX(APCDI,.01))
+5 QUIT
End DoDot:1
+6 QUIT
FF ;
+1 NEW X
+2 IF $EXTRACT(IOST)="C"
SET DIR(0)="E"
SET DIR("A")="Press 'ENTER' to continue or '^' to exit"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET APCDQUIT=1
+3 SET APCDPG=APCDPG+1
+4 IF $DATA(IOF)
WRITE @IOF
+5 WRITE !?40,"PCC DATA ENTRY SITE PARAMETERS Page ",APCDPG,!!
+6 QUIT
