Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPTF41

DGPTF41.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ACT ; -- 701 actions
  1. G ACT1:DGST
  1. S DGCFL=0 I $D(DGCST),DGCST<2,'DGCST!$G(DGREL) S DGCFL=1
  1. W !," PTF ",$J("#"_PTF,7),?15,"actions: 1=Edit C=Close ^N=Another Screen",!
  1. I DGCFL W "CENSUS ",$S(DGCI:$J("#"_DGCI,7),1:" record"),?15,"actions: ",$S(DGCST=1:"P=Open E=Release",1:" L=Close")
  1. S Z="^CLOSE^1 Edit"
  1. I DGCFL S Z=Z_"^"_$S(DGCST=1:"P Open Census^E Release Census",1:"L Close for Census")
  1. W !?15," ^=Abort <RET> to Continue: "
  1. D READ
  1. ;
  1. I X="^"!(X="") G Q^DGPTF
  1. I DGCFL,DGCST=1,$E(X)="P"!($E(X)="E") G ACT^DGPTC1
  1. I DGCFL,'DGCST,$E(X)="L" G ACT^DGPTC1
  1. I X?1"^".E S DGPTSCRN=701 G ^DGPTFJ
  1. I X?1"C".E,'DGN G CLS^DGPTF4
  1. I X="O" G O^DGPTF4
  1. I X="R",DGN G REL
  1. I X'=1 D HELP G EN1^DGPTF4
  1. S DGCODSYS=$$CODESYS^DGPTIC10(PTF),DR=$S(DGCODSYS="ICD10":"[DG701-10D]",1:"[DG701]")
  1. ;used only for roll back icd10 to icd9
  1. I DR="[DG701]",$P($G(^DGPT(PTF,71)),U,4,999)'?."^" S DR="[DG701-10D]"
  1. S DIE="^DGPT(",(DGPTF,DA)=PTF D ^DIE
  1. F I=0,70 S B(I)="" S:$D(^DGPT(PTF,I)) B(I)=^(I)
  1. K DGPTF,DR,DGCODSYS,DGXX,DGTYPE
  1. G EN1^DGPTF4
  1. ;
  1. READ ; -- read X
  1. R X:DTIME S:'$T X="^",DGPTOUT="" D IN^DGHELP
  1. Q
  1. ;
  1. HELP ;
  1. W !,"Enter '1' to edit Principal & Admit Diagnosis"
  1. W !," 'C' to close out PTF record"
  1. 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"
  1. W !," '^' to stop the display"
  1. W !," '^N' to jump to screen #N (appears in upper right of screen '<N>')"
  1. W !," <RET> to continue on to the next screen"
  1. R !!,"Enter <RET> to continue: ",XS:DTIME
  1. Q
  1. ;
  1. ACT1 ;
  1. W !," PTF ",$J("#"_PTF,7),?15,"actions: O=Open R=Release ^N=Another Screen",!
  1. I $D(DGCST),DGCST=1 W "CENSUS ",$J("#"_DGCI,7),?15,"action : E=Release"
  1. W !?15," ^=Abort <RET> to continue: "
  1. S Z="^OPEN^RELEASE PTF^E RELEASE CENSUS"
  1. D READ
  1. I $D(DGCST),DGCST=1,$E(X)="E" G ACT^DGPTC1
  1. I X=""!(X=U) G Q^DGPTF
  1. I X?1"^".E S DGPTSCRN=701 G ^DGPTFJ
  1. I X="O" G O^DGPTF4
  1. I X="R" G REL
  1. ;
  1. W !,"Enter 'O' to re-open a PTF record"
  1. W !," 'R' to release a PTF record"
  1. I $D(DGCST),DGCST=1 W !," 'E' to release a Census record"
  1. W !," '^' to stop the display"
  1. W !," '^N' to jump to screen #N (appears in upper right of screen '<N>')"
  1. W !," <RET> to continue on to the next screen"
  1. R !!,"Enter <RET> to continue: ",XS:DTIME
  1. G EN1^DGPTF4
  1. ;
  1. REL ;
  1. S Y=1 D RTY^DGPTUTL S DGPTFLE=1,DGPTIFN=PTF D EN^DGPTFREL G ^DGPTF
  1. ;