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