- 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 Feb 19, 2025@00:18:07 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 ;