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

AQAQEDT.m

Go to the documentation of this file. 
  1. AQAQEDT ;IHS/ANMC/LJF - MAIN DRIVER FOR DATA ENTRY; [ 09/15/95  8:46 AM ]
  1.  ;;2.2;STAFF CREDENTIALS;**7**;01 OCT 1992
  1.  ;
  1.  ;This routine uses the QI Data Entry file to create data entry
  1.  ;screens and controls editing of those screens.
  1.  ;The calling option sends AQAQOPTN (option name) before calling rtn
  1.  ;5/2/94 Routine modified to work with changes to QI Data Entry file
  1.  ;needed by QAI Mgt. System.  Distributed in patch AQAO*1*1.
  1.  ;
  1. SETOPT K DIC S X=AQAQOPTN,DIC(0)="",DIC="^AQAQX("
  1.  D ^DIC G END:Y=-1 S AQAQPT=+Y
  1.  ;
  1.  ;***> for each provider, choose pages and data items to enter/edit
  1.  F  D  Q:$D(DIRUT)  Q:Y=-1
  1.  .D GETPROV Q:X=U  Q:X=""
  1.  .D PAGELOOP K DIRUT
  1.  ;
  1. END ;***> eoj
  1.  D KILL^AQAQUTIL Q
  1.  ;
  1.  ;>>>>END OF MAIN ROUTINE; SUBRTNS TO FOLLOW<<<<<
  1.  ;
  1. GETPROV ;>>subrtn ask for provider & find/create entry in Credentialing file<<
  1.  ;***> ask provider name
  1.  K DIC S DIC("A")="Select PROVIDER NAME:  ",DIC(0)="AELMQZ"
  1.  S (DIC,DLAYGO)=9002165 D ^DIC
  1.  Q:X=U  Q:X=""  G GETPROV:Y=-1 S AQAQPRV=+Y
  1.  S AQAQPRVN=$P(^DIC(16,AQAQPRV,0),U) ;provider name
  1.  S AQAQPRVC="",Y=$P($G(^DIC(6,AQAQPRV,0)),U,4)
  1.  I Y]"" S C=$P(^DD(6,2,0),U,2) D Y^DIQ S AQAQPRVC=Y ;provider class
  1.  Q
  1.  ;
  1.  ;
  1. PAGELOOP ;>>subrtn to get each page (screen), display items and do edit<<
  1.  ;***> find all pages available to work on
  1.  S AQAQPG=0,AQAQOPTT=$P(^AQAQX(AQAQPT,0),U,2)
  1.  W @IOF,!?80-$L(AQAQOPTT)/2,AQAQOPTT
  1.  W !?80-$L(AQAQPRVN)/2,AQAQPRVN
  1.  W !?80-$L(AQAQPRVC)/2,AQAQPRVC
  1.  W !!
  1.  F  S AQAQPG=$O(^AQAQX(AQAQPT,"PG","B",AQAQPG)) Q:AQAQPG=""  D
  1.  .K DIR S AQAQPN=0,DIR(0)="LO^0:"_AQAQPG
  1.  .F  S AQAQPN=$O(^AQAQX(AQAQPT,"PG","B",AQAQPG,AQAQPN)) Q:AQAQPN=""  D
  1.  ..Q:'$D(^AQAQX(AQAQPT,"PG",AQAQPN,0))
  1.  ..S AQAQPTL=$P(^AQAQX(AQAQPT,"PG",AQAQPN,0),U,3)
  1.  ..S AQAQP(AQAQPG)=AQAQPTL_U_AQAQPN W !?5,AQAQPG,") ",AQAQPTL
  1.  ..Q
  1.  ;
  1.  ;***> choose page to work on
  1.  W !!
  1.  S DIR("A")="Choose category to edit (Enter 0 for ALL categories)"
  1.  D ^DIR Q:$D(DIRUT)  G PAGELOOP:Y=-1 S Y=$E(Y,1,$L(Y)-1)
  1.  I $D(^AQAQC(AQAQPRV,2)) S $P(^(2),U,3,4)=DT_U_DUZ ;editing user
  1.  ;
  1.  ;***> loop thru all pages selected
  1.  K DIROUT
  1.  S AQAQXLF(".")=",",Y=$$REPLACE^XLFSTR(Y,.AQAQXLF) K AQAQXLF ;PATCH #7
  1.  I Y=0 S AQAQO="" F  S X=$O(AQAQP(X)) Q:X=""  S AQAQO=AQAQO_","_X
  1.  E  S AQAQO=Y
  1.  I AQAQO?1",".E S AQAQO=$E(AQAQO,2,99)
  1.  F AQAQ=1:1 S Y=$P(AQAQO,",",AQAQ) Q:Y=""  Q:$D(DIROUT)  Q:$D(DUOUT)  D
  1.  .S AQAQPTL=$P(AQAQP(Y),U),AQAQPN=$P(AQAQP(Y),U,2)
  1.  .W @IOF,!?80-$L(AQAQPTL)/2,AQAQPTL ;page title
  1.  .W !?80-$L(AQAQPRVN)/2,AQAQPRVN ;print provider name
  1.  .W !?80-$L(AQAQPRVC)/2,AQAQPRVC,!! ;print provider class
  1.  .W $P(^AQAQX(AQAQPT,"PG",AQAQPN,0),U,4),! ;page heading
  1.  .K DIR S Y=$P(^AQAQX(AQAQPT,"PG",AQAQPN,0),U,2)
  1.  .I Y]"" S C=$P(^DD(9002166.11,.02,0),U,2) D Y^DIQ S (DIR("A"),AQAQDIR)=Y ;PATCH #7
  1.  .;
  1.  .;***> display items and ask user for choice, and then edit via ^die
  1.  .S AQAQTM=0
  1.  .S AQAQSTR=$S('$D(^AQAQX(AQAQPT,"PG",AQAQPN,1)):"",1:^(1))
  1.  .I $D(^AQAQX(AQAQPT,"PG",AQAQPN,2)) S DA=AQAQPRV X ^(2) Q  ;IHS/ORDC/LJF 10/5/93 change for QAI pkg
  1.  .I $P(AQAQSTR,U)'="" D MULTFIND^AQAQEDTS Q  ;multiple field page
  1.  .D ITEMFIND^AQAQEDTS:$P(AQAQSTR,U)="" ;multiple items on page
  1.  .Q
  1.  Q:$D(DIROUT)  Q:X="^^"
  1.  G PAGELOOP
  1.  ;>>end of PAGELOOP subrtn<<