- 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)
