ADGPCAC.m

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