DGPTF41 ;ALB/JDS/PLT - PTF ENTRY/EDIT-4 ;11/15/06 8:37am
;;5.3;Registration;**64,635,729,850,884**;Aug 13, 1993;Build 31
;;Per VA Directive 6402, this routine should not be modified.
;
ACT ; -- 701 actions
G ACT1:DGST
S DGCFL=0 I $D(DGCST),DGCST<2,'DGCST!$G(DGREL) S DGCFL=1
W !," PTF ",$J("#"_PTF,7),?15,"actions: 1=Edit C=Close ^N=Another Screen",!
I DGCFL W "CENSUS ",$S(DGCI:$J("#"_DGCI,7),1:" record"),?15,"actions: ",$S(DGCST=1:"P=Open E=Release",1:" L=Close")
S Z="^CLOSE^1 Edit"
I DGCFL S Z=Z_"^"_$S(DGCST=1:"P Open Census^E Release Census",1:"L Close for Census")
W !?15," ^=Abort <RET> to Continue: "
D READ
;
I X="^"!(X="") G Q^DGPTF
I DGCFL,DGCST=1,$E(X)="P"!($E(X)="E") G ACT^DGPTC1
I DGCFL,'DGCST,$E(X)="L" G ACT^DGPTC1
I X?1"^".E S DGPTSCRN=701 G ^DGPTFJ
I X?1"C".E,'DGN G CLS^DGPTF4
I X="O" G O^DGPTF4
I X="R",DGN G REL
I X'=1 D HELP G EN1^DGPTF4
S DGCODSYS=$$CODESYS^DGPTIC10(PTF),DR=$S(DGCODSYS="ICD10":"[DG701-10D]",1:"[DG701]")
;used only for roll back icd10 to icd9
I DR="[DG701]",$P($G(^DGPT(PTF,71)),U,4,999)'?."^" S DR="[DG701-10D]"
S DIE="^DGPT(",(DGPTF,DA)=PTF D ^DIE
F I=0,70 S B(I)="" S:$D(^DGPT(PTF,I)) B(I)=^(I)
K DGPTF,DR,DGCODSYS,DGXX,DGTYPE
G EN1^DGPTF4
;
READ ; -- read X
R X:DTIME S:'$T X="^",DGPTOUT="" D IN^DGHELP
Q
;
HELP ;
W !,"Enter '1' to edit Principal & Admit Diagnosis"
W !," 'C' to close out PTF record"
I DGCFL W:DGCST=1 !," 'P' to re-open a Census record",!," 'E' to release a Census record" W:'DGCST !," 'L' to close for Census"
W !," '^' to stop the display"
W !," '^N' to jump to screen #N (appears in upper right of screen '<N>')"
W !," <RET> to continue on to the next screen"
R !!,"Enter <RET> to continue: ",XS:DTIME
Q
;
ACT1 ;
W !," PTF ",$J("#"_PTF,7),?15,"actions: O=Open R=Release ^N=Another Screen",!
I $D(DGCST),DGCST=1 W "CENSUS ",$J("#"_DGCI,7),?15,"action : E=Release"
W !?15," ^=Abort <RET> to continue: "
S Z="^OPEN^RELEASE PTF^E RELEASE CENSUS"
D READ
I $D(DGCST),DGCST=1,$E(X)="E" G ACT^DGPTC1
I X=""!(X=U) G Q^DGPTF
I X?1"^".E S DGPTSCRN=701 G ^DGPTFJ
I X="O" G O^DGPTF4
I X="R" G REL
;
W !,"Enter 'O' to re-open a PTF record"
W !," 'R' to release a PTF record"
I $D(DGCST),DGCST=1 W !," 'E' to release a Census record"
W !," '^' to stop the display"
W !," '^N' to jump to screen #N (appears in upper right of screen '<N>')"
W !," <RET> to continue on to the next screen"
R !!,"Enter <RET> to continue: ",XS:DTIME
G EN1^DGPTF4
;
REL ;
S Y=1 D RTY^DGPTUTL S DGPTFLE=1,DGPTIFN=PTF D EN^DGPTFREL G ^DGPTF
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTF41 2740 printed Dec 13, 2024@02:52:05 Page 2
DGPTF41 ;ALB/JDS/PLT - PTF ENTRY/EDIT-4 ;11/15/06 8:37am
+1 ;;5.3;Registration;**64,635,729,850,884**;Aug 13, 1993;Build 31
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
ACT ; -- 701 actions
+1 if DGST
GOTO ACT1
+2 SET DGCFL=0
IF $DATA(DGCST)
IF DGCST<2
IF 'DGCST!$GET(DGREL)
SET DGCFL=1
+3 WRITE !," PTF ",$JUSTIFY("#"_PTF,7),?15,"actions: 1=Edit C=Close ^N=Another Screen",!
+4 IF DGCFL
WRITE "CENSUS ",$SELECT(DGCI:$JUSTIFY("#"_DGCI,7),1:" record"),?15,"actions: ",$SELECT(DGCST=1:"P=Open E=Release",1:" L=Close")
+5 SET Z="^CLOSE^1 Edit"
+6 IF DGCFL
SET Z=Z_"^"_$SELECT(DGCST=1:"P Open Census^E Release Census",1:"L Close for Census")
+7 WRITE !?15," ^=Abort <RET> to Continue: "
+8 DO READ
+9 ;
+10 IF X="^"!(X="")
GOTO Q^DGPTF
+11 IF DGCFL
IF DGCST=1
IF $EXTRACT(X)="P"!($EXTRACT(X)="E")
GOTO ACT^DGPTC1
+12 IF DGCFL
IF 'DGCST
IF $EXTRACT(X)="L"
GOTO ACT^DGPTC1
+13 IF X?1"^".E
SET DGPTSCRN=701
GOTO ^DGPTFJ
+14 IF X?1"C".E
IF 'DGN
GOTO CLS^DGPTF4
+15 IF X="O"
GOTO O^DGPTF4
+16 IF X="R"
IF DGN
GOTO REL
+17 IF X'=1
DO HELP
GOTO EN1^DGPTF4
+18 SET DGCODSYS=$$CODESYS^DGPTIC10(PTF)
SET DR=$SELECT(DGCODSYS="ICD10":"[DG701-10D]",1:"[DG701]")
+19 ;used only for roll back icd10 to icd9
+20 IF DR="[DG701]"
IF $PIECE($GET(^DGPT(PTF,71)),U,4,999)'?."^"
SET DR="[DG701-10D]"
+21 SET DIE="^DGPT("
SET (DGPTF,DA)=PTF
DO ^DIE
+22 FOR I=0,70
SET B(I)=""
if $DATA(^DGPT(PTF,I))
SET B(I)=^(I)
+23 KILL DGPTF,DR,DGCODSYS,DGXX,DGTYPE
+24 GOTO EN1^DGPTF4
+25 ;
READ ; -- read X
+1 READ X:DTIME
if '$TEST
SET X="^"
SET DGPTOUT=""
DO IN^DGHELP
+2 QUIT
+3 ;
HELP ;
+1 WRITE !,"Enter '1' to edit Principal & Admit Diagnosis"
+2 WRITE !," 'C' to close out PTF record"
+3 IF DGCFL
if DGCST=1
WRITE !," 'P' to re-open a Census record",!," 'E' to release a Census record"
if 'DGCST
WRITE !," 'L' to close for Census"
+4 WRITE !," '^' to stop the display"
+5 WRITE !," '^N' to jump to screen #N (appears in upper right of screen '<N>')"
+6 WRITE !," <RET> to continue on to the next screen"
+7 READ !!,"Enter <RET> to continue: ",XS:DTIME
+8 QUIT
+9 ;
ACT1 ;
+1 WRITE !," PTF ",$JUSTIFY("#"_PTF,7),?15,"actions: O=Open R=Release ^N=Another Screen",!
+2 IF $DATA(DGCST)
IF DGCST=1
WRITE "CENSUS ",$JUSTIFY("#"_DGCI,7),?15,"action : E=Release"
+3 WRITE !?15," ^=Abort <RET> to continue: "
+4 SET Z="^OPEN^RELEASE PTF^E RELEASE CENSUS"
+5 DO READ
+6 IF $DATA(DGCST)
IF DGCST=1
IF $EXTRACT(X)="E"
GOTO ACT^DGPTC1
+7 IF X=""!(X=U)
GOTO Q^DGPTF
+8 IF X?1"^".E
SET DGPTSCRN=701
GOTO ^DGPTFJ
+9 IF X="O"
GOTO O^DGPTF4
+10 IF X="R"
GOTO REL
+11 ;
+12 WRITE !,"Enter 'O' to re-open a PTF record"
+13 WRITE !," 'R' to release a PTF record"
+14 IF $DATA(DGCST)
IF DGCST=1
WRITE !," 'E' to release a Census record"
+15 WRITE !," '^' to stop the display"
+16 WRITE !," '^N' to jump to screen #N (appears in upper right of screen '<N>')"
+17 WRITE !," <RET> to continue on to the next screen"
+18 READ !!,"Enter <RET> to continue: ",XS:DTIME
+19 GOTO EN1^DGPTF4
+20 ;
REL ;
+1 SET Y=1
DO RTY^DGPTUTL
SET DGPTFLE=1
SET DGPTIFN=PTF
DO EN^DGPTFREL
GOTO ^DGPTF
+2 ;
