DGPTF5.m

DGPTF5 ;ALB/MTC - PTF ENTRY/EDIT-4 ; 07 JUN 91 

 ;;5.3;Registration;**669,701,744,1015**;Aug 13, 1993;Build 21

 ;

Z I 'DGN S Z=$S(IOST="C-QUME"&($L(DGVI)'=2):Z,1:"["_Z_"]") W @DGVI,Z,@DGVO

 E  W "   "

 Q

 ;

Z1 F I=1:1:(Z1-$L(Z)) S Z=Z_" "

 W Z

 Q

 ;

CEN ;

 W !!,*7,"Record #",PTF," MUST be closed for CENSUS first.",!

ASK W !,"Would you like to close this record for CENSUS" S %=2 D YN^DICN

 I '% W !?5,"Answer 'YES' to close record for CENSUS also",!?5,"  or   'NO'  to not close this record at all." G ASK

 I %=1 S Y=2 D RTY^DGPTUTL D CLS^DGPTC1

 K DGRTY,DGRTY0 Q

ICDEN ;enter icd codes

 I $G(X)["?" Q

 N DIC,Y I $G(X)="?BAD" S X="" Q

 ; DG*5.3*701 (movement)

 I DA'=$G(DGPTF),DA<25,$G(DA(1))>0 D CONFIG^LEXSET("ICD",,$$GETDATE^ICDGTDRG(DA(1)))

 ; DG*5.3*744 (801 screen)

 E  I DA'=$G(PTF),$D(^DGPT(PTF)) D CONFIG^LEXSET("ICD",,$$GETDATE^ICDGTDRG($G(PTF)))

 E  D CONFIG^LEXSET("ICD",,$$GETDATE^ICDGTDRG(DA))

 S DIC="^LEX(757.01,",DIC(0)=$S('$L($G(X)):"",1:"")_"EQM"

 S DIC("A")="Enter ICD: "

 D ^DIC

 I Y=-1 S X="" Q

 S X=$G(Y(1))

 Q

ICDEN1 ;enter icd codes for DRG

 N DIC K X,Y

 D CONFIG^LEXSET("ICD",,$G(DGDAT))

 S DIC="^LEX(757.01,",DIC(0)=$S('$L($G(X)):"",1:"")_"EQM"

 S DIC("A")=PROMPT

 D ^DIC

 I Y=-1 S X="" Q

 S X=$G(Y(1))

 S Y=$$ICDDX^ICDCODE(X,$G(DGDAT))

 Q

DGPTF5    ;ALB/MTC - PTF ENTRY/EDIT-4 ; 07 JUN 91 

 +1       ;;5.3;Registration;**669,701,744,1015**;Aug 13, 1993;Build 21

 +2       ;

Z          IF 'DGN

               SET Z=$SELECT(IOST="C-QUME"&($LENGTH(DGVI)'=2):Z,1:"["_Z_"]")

               WRITE @DGVI,Z,@DGVO

 +1       IF '$TEST

               WRITE "   "

 +2        QUIT 

 +3       ;

Z1         FOR I=1:1:(Z1-$LENGTH(Z))

               SET Z=Z_" "

 +1        WRITE Z

 +2        QUIT 

 +3       ;

CEN       ;

 +1        WRITE !!,*7,"Record #",PTF," MUST be closed for CENSUS first.",!

ASK        WRITE !,"Would you like to close this record for CENSUS"

           SET %=2

           DO YN^DICN

 +1        IF '%

               WRITE !?5,"Answer 'YES' to close record for CENSUS also",!?5,"  or   'NO'  to not close this record at all."

               GOTO ASK

 +2        IF %=1

               SET Y=2

               DO RTY^DGPTUTL

               DO CLS^DGPTC1

 +3        KILL DGRTY,DGRTY0

           QUIT 

ICDEN     ;enter icd codes

 +1        IF $GET(X)["?"

               QUIT 

 +2        NEW DIC,Y

           IF $GET(X)="?BAD"

               SET X=""

               QUIT 

 +3       ; DG*5.3*701 (movement)

 +4        IF DA'=$GET(DGPTF)

               IF DA<25

                   IF $GET(DA(1))>0

                       DO CONFIG^LEXSET("ICD",,$$GETDATE^ICDGTDRG(DA(1)))

 +5       ; DG*5.3*744 (801 screen)

 +6       IF '$TEST

               IF DA'=$GET(PTF)

                   IF $DATA(^DGPT(PTF))

                       DO CONFIG^LEXSET("ICD",,$$GETDATE^ICDGTDRG($GET(PTF)))

 +7       IF '$TEST

               DO CONFIG^LEXSET("ICD",,$$GETDATE^ICDGTDRG(DA))

 +8        SET DIC="^LEX(757.01,"

           SET DIC(0)=$SELECT('$LENGTH($GET(X)):"",1:"")_"EQM"

 +9        SET DIC("A")="Enter ICD: "

 +10       DO ^DIC

 +11       IF Y=-1

               SET X=""

               QUIT 

 +12       SET X=$GET(Y(1))

 +13       QUIT 

ICDEN1    ;enter icd codes for DRG

 +1        NEW DIC

           KILL X,Y

 +2        DO CONFIG^LEXSET("ICD",,$GET(DGDAT))

 +3        SET DIC="^LEX(757.01,"

           SET DIC(0)=$SELECT('$LENGTH($GET(X)):"",1:"")_"EQM"

 +4        SET DIC("A")=PROMPT

 +5        DO ^DIC

 +6        IF Y=-1

               SET X=""

               QUIT 

 +7        SET X=$GET(Y(1))

 +8        SET Y=$$ICDDX^ICDCODE(X,$GET(DGDAT))

 +9        QUIT