- 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