Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCDSPD

APCDSPD.m

Go to the documentation of this file.
  1. APCDSPD ; IHS/CMI/LAB - display site parameters ;
  1. ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1. ;
  1. ;
  1. EN1 ;
  1. K APCDQUIT
  1. W:$D(IOF) @IOF
  1. W !!,"Display Patient Care Component Site Parameters",!
  1. S DIC="^APCDSITE(",DIC(0)="AEMQ" D ^DIC K DIC I Y=-1 W !!,"Goodbye" G XIT
  1. S APCDSITE=+Y
  1. 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
  1. G:$D(DIRUT) XIT
  1. I Y="B" D BROWSE,XIT Q
  1. S XBRP="PRINT^APCDSPD",XBRC="PROC^APCDSPD",XBRX="XIT^APCDSPD",XBNS="APCD"
  1. D ^XBDBQUE
  1. D XIT
  1. Q
  1. XIT ;EP
  1. K APCDSITE,APCDX,APCDI,APCDPG,Y
  1. Q
  1. BROWSE ;
  1. D VIEWR^XBLM("PRINT^APCDSPD","Patient Care Component Site Parameter Display")
  1. Q
  1. PROC ;
  1. Q
  1. PRINT ;
  1. S APCDPG=0
  1. K APCDX,APCDI
  1. W:$D(IOF) @IOF W !?15,"PATIENT CARE COMPONENT DATA ENTRY SITE PARAMETERS",!
  1. 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)
  1. S X=0 F S X=$O(APCDX(X)) Q:X'=+X!($D(APCDQUIT)) D
  1. .I $Y>(IOSL-4) D FF Q:$D(APCDQUIT)
  1. .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)
  1. HCDB ;
  1. K APCDX D ENPM^XBDIQ1(9001001.21101,"APCDSITE,0",".01","APCDX(")
  1. S APCDI=0 F S APCDI=$O(APCDX(APCDI)) Q:APCDI'=+APCDI D
  1. .I $Y>(IOSL-4) D FF Q:$D(APCDQUIT)
  1. .W !?3,"Acceptable Patient CHART LOCATIONS: ",$G(APCDX(APCDI,.01))
  1. .Q
  1. MNE ;
  1. K APCDX D ENPM^XBDIQ1(9001001.21201,APCDSITE_",0",".01","APCDX(")
  1. S APCDI=0 F S APCDI=$O(APCDX(APCDI)) Q:APCDI'=+APCDI D
  1. .I $Y>(IOSL-4) D FF Q:$D(APCDQUIT)
  1. .W !?3,"Mnemonics automatically prompted for in MINI: ",$G(APCDX(APCDI,.01))
  1. .Q
  1. Q
  1. FF ;
  1. NEW X
  1. 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
  1. S APCDPG=APCDPG+1
  1. W:$D(IOF) @IOF
  1. W !?40,"PCC DATA ENTRY SITE PARAMETERS Page ",APCDPG,!!
  1. Q