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

ADGPCAC.m

Go to the documentation of this file.
  1. ADGPCAC ; IHS/ADC/PDW/ENM - ADT/PCC DATA ENTRY ; [ 03/25/1999 11:48 AM ]
  1. ;;5.3;ADMISSION/DISCHARGE/TRANSFER;**1008**;MAR 25, 1999
  1. ;
  1. A ; -- main
  1. N I,ID,Y,J,N
  1. D SP I Y'>0 D Q Q
  1. D LV,SV I 'DGVI D Q Q
  1. D VR,Q1,^ADGPCAC0,VR1
  1. G A
  1. ;
  1. SP ; -- select patient
  1. S DIC="^DPT(",DIC(0)="AQEMZ",DIC("A")="Select PATIENT NAME: "
  1. D ^DIC K DIC S DFN=+Y
  1. Q
  1. LV ; -- admissions?
  1. S I=0 I '$O(^DGPM("APTT1",DFN,0)) W !?5,"No admissions on file." Q
  1. ; -- loop visits
  1. W !!,"Select from these UNEXPORTED ADMISSIONS: ",!
  1. S ID=0 F S ID=$O(^AUPNVSIT("AA",DFN,ID)) Q:'ID D
  1. . S DGVI=0 F S DGVI=$O(^AUPNVSIT("AA",DFN,ID,DGVI)) Q:'DGVI D VH
  1. Q
  1. ;
  1. VH ; -- inpatient visit? ;ihs or 638? ;v hosp?
  1. Q:'$D(^AUPNVSIT(DGVI,0)) S N=^(0) ;Q:$P(N,U,3)'="I"&($P(N,U,3)'=6) ;IHS/ANMC/LJF 5/29/98
  1. Q:$P(N,U,6)'=DUZ(2) ;IHS/ANMC/LJF 5/29/98
  1. Q:$P(N,U,14)]"" ;exported already
  1. S X1=DT,X2=+N D ^%DTC Q:X>500
  1. Q:'$O(^AUPNVINP("AD",DGVI,0)) Q:'$O(^DGPM("APTT1",DFN,+N,0))
  1. ; -- list and number visit(s) w/ v hosp
  1. S Y=+N X ^DD("DD") S I=I+1,J(I)=DGVI W !?15,I,". ",Y
  1. Q
  1. ;
  1. SV ; -- select visit
  1. I 'I W !?5,"No visits" S DGVI=0 D PRTOPT^ADGVAR Q
  1. I I=1 S DGVI=J(I) Q
  1. K DIR S DIR("A")="Select One",DIR(0)="NO^1:"_I D ^DIR
  1. I $D(DIRUT)!(Y=-1) S DGVI=0 Q
  1. S DGVI=J(X)
  1. Q
  1. ;
  1. VR ; -- pcc variables & mark visit as being edited
  1. D APCDEIN^ADGCALLS Q
  1. ;
  1. VR1 ;
  1. S N=$G(^AUPNVSIT(+$G(DGVI),0)) Q:'N
  1. I '$D(^AUPNVSIT("APCIS",+$P(N,U,2),+DGVI)) D
  1. . L +^AUPNVSIT(+DGVI):3 I '$T Q
  1. . S DIE="^AUPNVSIT(",DA=DGVI,DR=".13///"_DT D ^DIE L -^AUPNVSIT(DGVI)
  1. Q
  1. ;
  1. Q ; -- cleanup all
  1. D APCDEKL^ADGCALLS K DGVI,DFN
  1. Q1 ; -- cleanup rtn
  1. K DIR,DIRUT,DIE,DIC,DR,DA Q