ADGPCAC0.m

ADGPCAC0 ; IHS/ADC/PDW/ENM - ADT/PCC DATA ENTRY ;  [ 03/25/1999  11:48 AM ]

 ;;5.3;ADMISSION/DISCHARGE/TRANSFER;**1008**;MAR 25, 1999

 ;

 D ^ADGPCAC1

 S APCDCAT="H",APCDVSIT=DGVI,APCDPAT=DFN,APCDTYPE="I"

 S APCDVLK=DGVI,APCDLOC=DUZ(2)

SF ; -- select function

 W !! K DIR S DIR(0)="NO^1:8",DIR("A")="Select One (by number)"

 S DIR("A",1)="  (1) ADMISSION DATA           (3) PROCEDURE(S)"

 S DIR("A",2)="  (2) POV (DIAGNOSIS)          (4) PROVIDER(S)"

 S DIR("A",3)="  (5) IMMUNIZATIONS            (6) PROBLEM LIST"

 S DIR("A",4)="  (7) OTHER MNEMONICS          (8) review clinical data"

 D ^DIR G:$D(DIRUT) VC G SF:Y=-1 S DGF=Y

FUN ; -- function

 I DGF=1 D  G SF

 . I '$D(^DGPM("APTT1",DFN)) W !,"No admissions on file",! Q

 . L +^AUPNVINP($$VH):3 I '$T D  G SF

 .. W !,*7,"SOMEONE ELSE IS UPDATING THIS HOSPITALIZATION"

 .. W "; TRY AGAIN LATER"

 . K DIC,DIE S DIE="^AUPNVINP(",DA=$$VH,DR=".08;.12" D ^DIE  ;consults

 . L -^AUPNVINP($$VH)

 . N DGPMCA,DGPMEX,DGPMAN S DGPMCA=$$CA,DGPMAN=$G(^DGPM(+DGPMCA,0))

 . S DGZDFN=APCDPAT

 . S ^DISV(DUZ,"DGPMEX",DFN)=DGPMCA D ENEX^DGPMV20,ASK^DGPMEX S (DFN,APCDPAT)=DGZDFN K DGZDFN

 I DGF=8 W @IOF D ^ADGPCAC1 G SF

 W !! K DIR S DIR(0)="SO^A:ADD;M:MODIFY",DIR("A")="Select MODE"

 I DGF'=7 D  S DIR("A")=" "

 . S DIR("A",1)="Enter 'A' to add a new "_$$MOD_" OR"

 . S DIR("A",2)="Enter 'M' to modify an existing "_$$MOD

 D ^DIR S APCDMODE=$S(Y["A":"A",Y["M":"M",1:"")

 G:APCDMODE="" SF

PCC ; -- set mnemonic and call PCC data entry rtn

 S DIC="^APCDTKW(",DIC(0)=""

 I DGF=7 S DIC(0)="AEMQ",DIC("A")="MNEMONIC: "

 S X=$S(DGF=2:"PV",DGF=3:"OP",DGF=4:"PRV",DGF=5:"IM",DGF=6:"PO",1:"")

 S DIC("S")="I $L($P(^(0),U,1))<4" D ^DIC K DIC I Y<0 G FUN

 S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2) D APCDEA3^ADGCALLS

 G FUN

VC ; -- visit check

 S APCDVSIT=DGVI D APCDCHK^ADGCALLS  ;to check pcc inpatient edits

Q ; -- cleanup

 K DGF,DIC,X,Y Q

 ;

VH() ; -- v hospitalization ien

 Q $O(^AUPNVINP("AD",DGVI,0))

 ;

CA() ; -- corresponding admission

 Q $O(^DGPM("AMV1",+^AUPNVSIT(DGVI,0),DFN,0))

 ;

MOD() ;

 Q $S(DGF=2:"diagnosis",DGF=3:"procedure",DGF=4:"provider",DGF=5:"immunization",DGF=6:"problem",1:"")

 ;

LOCKOUT(DATE) ;EP -- called to check lock out date

 ; -- returns 1 if admission is locked

 ; -- called by DGPMEX,DGPMV21

 NEW X,X1,X2

 S X1=DT,X2=DATE D ^%DTC

 Q $S(X>$P($G(^DG(43,1,9999999)),U,6):1,1:0)

ADGPCAC0  ; 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       ;

 +3        DO ^ADGPCAC1

 +4        SET APCDCAT="H"

           SET APCDVSIT=DGVI

           SET APCDPAT=DFN

           SET APCDTYPE="I"

 +5        SET APCDVLK=DGVI

           SET APCDLOC=DUZ(2)

SF        ; -- select function

 +1        WRITE !!

           KILL DIR

           SET DIR(0)="NO^1:8"

           SET DIR("A")="Select One (by number)"

 +2        SET DIR("A",1)="  (1) ADMISSION DATA           (3) PROCEDURE(S)"

 +3        SET DIR("A",2)="  (2) POV (DIAGNOSIS)          (4) PROVIDER(S)"

 +4        SET DIR("A",3)="  (5) IMMUNIZATIONS            (6) PROBLEM LIST"

 +5        SET DIR("A",4)="  (7) OTHER MNEMONICS          (8) review clinical data"

 +6        DO ^DIR

           IF $DATA(DIRUT)

               GOTO VC

           IF Y=-1

               GOTO SF

           SET DGF=Y

FUN       ; -- function

 +1        IF DGF=1

               Begin DoDot:1

 +2                IF '$DATA(^DGPM("APTT1",DFN))

                       WRITE !,"No admissions on file",!

                       QUIT 

 +3                LOCK +^AUPNVINP($$VH):3

                   IF '$TEST

                       Begin DoDot:2

 +4                        WRITE !,*7,"SOMEONE ELSE IS UPDATING THIS HOSPITALIZATION"

 +5                        WRITE "; TRY AGAIN LATER"

                       End DoDot:2

                       GOTO SF

 +6       ;consults

                   KILL DIC,DIE

                   SET DIE="^AUPNVINP("

                   SET DA=$$VH

                   SET DR=".08;.12"

                   DO ^DIE

 +7                LOCK -^AUPNVINP($$VH)

 +8                NEW DGPMCA,DGPMEX,DGPMAN

                   SET DGPMCA=$$CA

                   SET DGPMAN=$GET(^DGPM(+DGPMCA,0))

 +9                SET DGZDFN=APCDPAT

 +10               SET ^DISV(DUZ,"DGPMEX",DFN)=DGPMCA

                   DO ENEX^DGPMV20

                   DO ASK^DGPMEX

                   SET (DFN,APCDPAT)=DGZDFN

                   KILL DGZDFN

               End DoDot:1

               GOTO SF

 +11       IF DGF=8

               WRITE @IOF

               DO ^ADGPCAC1

               GOTO SF

 +12       WRITE !!

           KILL DIR

           SET DIR(0)="SO^A:ADD;M:MODIFY"

           SET DIR("A")="Select MODE"

 +13       IF DGF'=7

               Begin DoDot:1

 +14               SET DIR("A",1)="Enter 'A' to add a new "_$$MOD_" OR"

 +15               SET DIR("A",2)="Enter 'M' to modify an existing "_$$MOD

               End DoDot:1

               SET DIR("A")=" "

 +16       DO ^DIR

           SET APCDMODE=$SELECT(Y["A":"A",Y["M":"M",1:"")

 +17       IF APCDMODE=""

               GOTO SF

PCC       ; -- set mnemonic and call PCC data entry rtn

 +1        SET DIC="^APCDTKW("

           SET DIC(0)=""

 +2        IF DGF=7

               SET DIC(0)="AEMQ"

               SET DIC("A")="MNEMONIC: "

 +3        SET X=$SELECT(DGF=2:"PV",DGF=3:"OP",DGF=4:"PRV",DGF=5:"IM",DGF=6:"PO",1:"")

 +4        SET DIC("S")="I $L($P(^(0),U,1))<4"

           DO ^DIC

           KILL DIC

           IF Y<0

               GOTO FUN

 +5        SET APCDMNE=+Y

           SET APCDMNE("NAME")=$PIECE(Y,U,2)

           DO APCDEA3^ADGCALLS

 +6        GOTO FUN

VC        ; -- visit check

 +1       ;to check pcc inpatient edits

           SET APCDVSIT=DGVI

           DO APCDCHK^ADGCALLS

Q         ; -- cleanup

 +1        KILL DGF,DIC,X,Y

           QUIT 

 +2       ;

VH()      ; -- v hospitalization ien

 +1        QUIT $ORDER(^AUPNVINP("AD",DGVI,0))

 +2       ;

CA()      ; -- corresponding admission

 +1        QUIT $ORDER(^DGPM("AMV1",+^AUPNVSIT(DGVI,0),DFN,0))

 +2       ;

MOD()     ;

 +1        QUIT $SELECT(DGF=2:"diagnosis",DGF=3:"procedure",DGF=4:"provider",DGF=5:"immunization",DGF=6:"problem",1:"")

 +2       ;

LOCKOUT(DATE) ;EP -- called to check lock out date

 +1       ; -- returns 1 if admission is locked

 +2       ; -- called by DGPMEX,DGPMV21

 +3        NEW X,X1,X2

 +4        SET X1=DT

           SET X2=DATE

           DO ^%DTC

 +5        QUIT $SELECT(X>$PIECE($GET(^DG(43,1,9999999)),U,6):1,1:0)