source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTF5.m@ 1578

Last change on this file since 1578 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1DGPTF5 ;ALB/MTC - PTF ENTRY/EDIT-4 ; 07 JUN 91
2 ;;5.3;Registration;**669,701,744**;Aug 13, 1993;Build 5
3 ;
4Z I 'DGN S Z=$S(IOST="C-QUME"&($L(DGVI)'=2):Z,1:"["_Z_"]") W @DGVI,Z,@DGVO
5 E W " "
6 Q
7 ;
8Z1 F I=1:1:(Z1-$L(Z)) S Z=Z_" "
9 W Z
10 Q
11 ;
12CEN ;
13 W !!,*7,"Record #",PTF," MUST be closed for CENSUS first.",!
14ASK W !,"Would you like to close this record for CENSUS" S %=2 D YN^DICN
15 I '% W !?5,"Answer 'YES' to close record for CENSUS also",!?5," or 'NO' to not close this record at all." G ASK
16 I %=1 S Y=2 D RTY^DGPTUTL D CLS^DGPTC1
17 K DGRTY,DGRTY0 Q
18ICDEN ;enter icd codes
19 I $G(X)["?" Q
20 N DIC,Y I $G(X)="?BAD" S X="" Q
21 ; DG*5.3*701 (movement)
22 I DA'=$G(DGPTF),DA<25,$G(DA(1))>0 D CONFIG^LEXSET("ICD",,$$GETDATE^ICDGTDRG(DA(1)))
23 ; DG*5.3*744 (801 screen)
24 E I DA'=$G(PTF),$D(^DGPT(PTF)) D CONFIG^LEXSET("ICD",,$$GETDATE^ICDGTDRG($G(PTF)))
25 E D CONFIG^LEXSET("ICD",,$$GETDATE^ICDGTDRG(DA))
26 S DIC="^LEX(757.01,",DIC(0)=$S('$L($G(X)):"",1:"")_"EQM"
27 S DIC("A")="Enter ICD: "
28 D ^DIC
29 I Y=-1 S X="" Q
30 S X=$G(Y(1))
31 Q
32ICDEN1 ;enter icd codes for DRG
33 N DIC K X,Y
34 D CONFIG^LEXSET("ICD",,$G(DGDAT))
35 S DIC="^LEX(757.01,",DIC(0)=$S('$L($G(X)):"",1:"")_"EQM"
36 S DIC("A")=PROMPT
37 D ^DIC
38 I Y=-1 S X="" Q
39 S X=$G(Y(1))
40 S Y=$$ICDDX^ICDCODE(X,$G(DGDAT))
41 Q
Note: See TracBrowser for help on using the repository browser.