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

DGPTFM2.m

Go to the documentation of this file. 
  1. DGPTFM2 ;ALB/DWS - MASTER PROFESSIONAL SERVICE ENTER/EDIT ;6/16/05 8:33am
  1.  ;;5.3;Registration;**517,590,606,635,850,912,1057**;Aug 13, 1993;Build 17
  1. ADD ;ADD CPT RECORD
  1.  N DGZP S DGZP=0 S:'$D(^DGPT(PTF,"C",0)) ^(0)="^45.06D^^"
  1.  S DIC="^DGPT("_PTF_",""C"",",DIC(0)="AELQMXZ",DA(1)=PTF,DLAYGO=45
  1.  D ^DIC K DIC,DLAYGO G ^DGPTFM:Y'>0,^DGPTFM:'$D(^DGPT(PTF,"C",+Y))
  1.  S DGPSM=+Y
  1.  I '$P(Y,U,3) S DIR("A")="Do you want to edit this CPT RECORD DATE/TIME?",DIR(0)="Y",DIR("B")="YES" D ^DIR G ^DGPTFM:'Y!$D(DIRUT)
  1.  D MOB
  1.  I $P(DGZPRF,U,3) F I=1:1:$P(DGZPRF,U,3) S:DGZPRF(I,0)=DGPSM DGZP=I
  1.  K I G:'DGZP ^DGPTFM S X="A,B",DGPSM=0
  1. ED G HELP^DGPTUTL1:X'["A"&(X'["B")&(X'["a")&(X'["b") K DA
  1.  S DGJUMP=X,DGPRD=+DGZPRF(DGZP),X1="^801"
  1.  I X["A"!(X["a") D  L -^DGPT(PTF) I FLAG D MOB,REQ^DGPTFM3 G EXIT
  1.  .S DA(1)=PTF,DIE="^DGPT("_PTF_",""C"",",(DA,REC)=DGZPRF(DGZP,0)
  1.  .S DR=".01;.02;.03;.05;.09////0",DIC(0)="AELQZ" Q:'$$LOCK
  1.  .D FMDIE S FLAG=$D(Y)>9!$D(DOUT)!'$D(DA) Q:$D(Y)>9!'$D(DA)
  1.  .S DGPRD=+^DGPT(PTF,"C",DGZPRF(DGZP,0),0) Q:+DGZPRF(DGZP)=DGPRD
  1.  .S DGI=0 F  S DGI=$O(^DGCPT(46,"C",PTF,DGI)) Q:DGI'>0  D  Q:$D(Y)>9!'$D(DA)
  1.  ..Q:+^DGCPT(46,DGI,1)'=+DGZPRF(DGZP)  Q:$D(^(9))
  1.  ..S DR=".14////"_DGPRD,(DA,REC)=DGI,DIE="^DGCPT(46," D FMDIE
  1.  ..I $D(Y)>9!'$D(DA) S FLAG=1
  1.  ..;ADD IMPDATE check to see if Edit on date changed coding system
  1.  . I $P(DGZPRF(DGZP),U)<IMPDATE,DGPRD'<IMPDATE D EN^DDIOL("Primary Diagnosis changing from ICD-9 to ICD-10. You must edit the Diagnosis.") S DGJUMP="B"
  1.  . I $P(DGZPRF(DGZP),U)'<IMPDATE,DGPRD<IMPDATE D EN^DDIOL("Primary Diagnosis changing from ICD-10 to ICD-9. You must edit the Diagnosis.") S DGJUMP="B"
  1.  .S $P(DGZPRF(DGZP),U)=DGPRD
  1. JUMP I DGJUMP["B"!(DGJUMP["b") S DGI=0 D CL^SDCO21(DFN,DGPRD,"",.SDCLY) D
  1.  .F  S DGI=$O(^DGCPT(46,"C",PTF,DGI)) Q:DGI'>0  I +^DGCPT(46,DGI,1)=+DGZPRF(DGZP),'$G(^(9)) D  I $D(DUOUT) Q:'DGDIAG  K DUOUT S DGI=0
  1.  ..S (DA,REC)=DGI,DR=".01;",DIE="^DGCPT(46," D GETINFO^DGPTFM21
  1.  .Q:$D(DUOUT)
  1.  .F  D  D ^DIC S A=0 Q:Y'>0  D SED Q:$D(DUOUT)
  1.  ..S DA=PTF,DIC="^DGCPT(46,",DIC(0)="AELMQZ",DLAYGO=46
  1.  ..S DIC("S")="D EN6^DGPTFJC I 'DGER"
  1.  I $D(DUOUT),$G(DGDIAG) K DUOUT G JUMP
  1.  I $D(DUOUT),$G(DGJUMP)["A"!($G(DGJUMP)["a") S X=DGJUMP K DUOUT G ED
  1.  K DR,DIE,DIC,DA,DGI,DGJUMP,DGPRD,DLAYGO,XREF
  1.  D REQ^DGPTFM3,MOB H:RFL 2 K RFL
  1.  G ^DGPTFM:'$D(DGZPRF(DGZP,0)),^DGPTFM:'$D(^DGPT(PTF,"C",DGZPRF(DGZP,0)))
  1. SET D MOB:'$D(DGZPRF) S:'$D(DGZP) DGZP=1 I $G(DGZPRF(DGZP,0))="" K DGZPRF(DGZP) G NEXP
  1. WRT G ^DGPTFM:'$D(^DGPT(PTF,"C",DGZPRF(DGZP,0),0)) S J=DGZP W @IOF,HEAD,?68
  1.  N DGNUM S Z="<"_DGZP_">" W @DGVI,Z,@DGVO
  1.  W !,?30,"Initial Date Of Service: ",$$EXTERNAL^DILFD(45,14,,$G(DGIDTS))  ; DG*5.3*1057
  1.  W !! S Y=+DGZPRF(J),Z="A"
  1.  D D^DGPTUTL,Z^DGPTFM5 W ?5,"CPT Record Date/Time: ",Y
  1.  I $P(DGZPRF(J),U,8)'="" W ?55,"Visit Service Category: ",$P(DGZPRF(J),U,8)
  1.  I $P(DGZPRF(J),U,2) W !,?5,"Referring or Ordering Provider: " D
  1.  .S L=$P(DGZPRF(J),U,2) D PRV^DGPTFM
  1.  W !,?5,"Rendering Provider: " S L=$P(DGZPRF(J),U,3) D PRV^DGPTFM
  1.  I $P(DGZPRF(J),U,5) W !,?5,"Rendering Location: ",$P($G(^SC($P(DGZPRF(J),U,5),0)),U)
  1.  W !! S Z="B" D Z^DGPTFM5 W "  Procedures:   "
  1.  F K=$P(DGZPRF,U,2):1 Q:'$D(DGZPRF(J,K))  I '$D(DGZPRF(J,K,9)) D
  1.  .W ?5 D CPT^DGPTUTL1 W ! Q:$Y>16
  1.  F I=1:1:(IOSL-$Y-5) W !
  1.  K I,J,K,L,Z S DGNUM=$S($D(DGZPRF(DGZP+1)):DGZP+1,1:"MAS")
  1.  G 801^DGPTFJC:DGST
  1.  S DIR("A")="Enter <RET> to continue, A-B to edit, 'I' to add an 801,"
  1.  S DIR("A")=DIR("A")_$C(10,13)_"the number of an 801 screen, ?? to list 801 screens,"
  1.  S DIR("A")=DIR("A")_$C(10,13)_"'S' for Send to PCE,"
  1.  S DIR("A")=DIR("A")_" '^N' for screen N, or '^' to abort:"
  1.  S DIR("?")="^D HELP^DGPTUTL1"
  1.  S DIR(0)="F^OU",DIR("B")=DGNUM,DIR("??")="^D DISP^DGPTUTL1" D ^DIR
  1.  K DIR G:$D(DIRUT) Q^DGPTF:X="^"
  1.  I X?1"^".E S DGPTSCRN=801 G ^DGPTFJ
  1.  I X="MAS" S DGZP=1 G ^DGPTFM
  1.  G ADD:X="I"!(X="i"),HELP^DGPTUTL1:X["?"
  1.  I X?1N.N,$D(DGZPRF(X)) S DGZP=X G SET
  1.  I X["A"!(X["B")!(X["a")!(X["b") G ED
  1.  I X="S"!(X="s") D PCE G WRT
  1.  D HELP^DGPTUTL1 R !!,"Enter <RET>: ",X:DTIME G WRT
  1. PCE L +^DGPT(PTF):2
  1.  I '$T W !,"CPT Record is being edited by another user" H 2 Q
  1.  D ICDINFO^DGAPI(DFN,PTF),XREF^DGPTFM21
  1.  S RES=$$DATA2PCE^DGAPI1(DFN,PTF,DGZP)
  1.  I RES=1 L -^DGPT(PTF) W !,"PTF Record sent to PCE" H 2 Q
  1.  W @IOF
  1.  ;F I=1:1 Q:'$D(^TMP("DGPAPI",$J,"DIERR",$J,1,"TEXT",I))  W !,^(I)
  1.  W !,"The PTF Record may not have been filed in PCE due to errors."
  1.  W !,"Press return to continue." R X:DTIME
  1.  L -^DGPT(PTF) Q
  1. NEXP S DGZP=DGZP+1
  1.  I '$D(DGZPRF(DGZP)) W:DGZP=2 !,"NO PROF. SERVICES TO EDIT." G EXIT
  1.  G SET
  1. EXIT K DGPSM H 2 S DGZP=1 G ^DGPTFM
  1. DEL ;DELETE A CPT RECORD
  1.  I '$P(DGZPRF,U,3) G NOPROC
  1. ASK S DIR("A")="Select 801 record to Delete"
  1.  S DIR(0)="NO^1:"_$P(DGZPRF,U,3),DIR("??")="^D DISP^DGPTUTL1"
  1.  D ^DIR K DIR G ^DGPTFM:$D(DIRUT),^DGPTFM:'Y,^DGPTFM:'$D(^DGPT(PTF,"C",DGZPRF(Y,0),0)) S DGZP=Y,Y=+^(0) D D^DGPTUTL
  1.  S DIR("A")="Are you sure you want to delete the entire 801 for "_Y
  1.  S DIR(0)="Y",DIR("B")="No" D ^DIR K DIR G ^DGPTFM:'Y,^DGPTFM:'$$LOCK
  1.  ;patch DG*5.3*912 modifies where the date is being set for deletion. This allows multiple cpt codes to be deleted from 801 in the ptf
  1.  S DGI=0
  1.  F  S DGI=$O(^DGCPT(46,"C",PTF,DGI)) Q:DGI'>0  D:+^DGCPT(46,DGI,1)=+DGZPRF(DGZP)&'$G(^(9))
  1.  .D NOW^%DTC S (DA,REC)=DGI,DIE="^DGCPT(46,",DR="1////^S X=%" D FMDIE
  1.  S DR=".09////1",DIE="^DGPT("_PTF_",""C"",",DA=DGZPRF(DGZP,0)
  1.  S DA(1)=PTF D ^DIE L -^DGPT(PTF)
  1.  W !!,"CPT Records....Deleted" H 2
  1.  K DIK,DA,DGI,DGPROC,DGPSM,DGPNUM,Y D MOB G ^DGPTFM
  1. NOPROC  W !!,*7,"No procedures to delete",! H 3 G ^DGPTFM
  1. N ;ADD CPT CODES TO CPT RECORD
  1.  I '$P(DGZPRF,U,3) W !!,"There are no 801 records that can be added to.",*7 H 2 G ^DGPTFM
  1. P1 S DIR("A")="Add to 801 record ",DIR(0)="NO^1:"_$P(DGZPRF,U,3)
  1.  S DIR("??")="^D DISP^DGPTUTL1"
  1.  D ^DIR K DIR G ^DGPTFM:'Y
  1.  S DGZP=Y,DGI=0,DGPRD=+DGZPRF(DGZP) D CL^SDCO21(DFN,DGPRD,"",.SDCLY)
  1.  S DA=PTF,DIC="^DGCPT(46,",DIC(0)="AELQMZ",DLAYGO=46,DIC("S")="D EN6^DGPTFJC I 'DGER"
  1.  D ^DIC K DIC,DLAYGO D:Y>0 SED,MOB,REQ^DGPTFM3 K DGPRD,Y
  1.  D PCE^DGPTFQWK G ^DGPTFM
  1. DC ;DELETE A CPT PROCEDURE
  1.  I $E($G(ANS),2,99)>0 S DGPZ=+$E(ANS,2,99) G QQ
  1.  S DIR("A")="Select 801 record to Delete a CPT code in"
  1.  S DIR(0)="NO^1:"_$P(DGZPRF,U,3),DIR("??")="^D DISP^DGPTUTL1"
  1.  D ^DIR K DIR G ^DGPTFM:$D(DIRUT),^DGPTFM:'Y,^DGPTFM:'$D(^DGPT(PTF,"C",DGZPRF(Y,0),0)) S DGZP=Y,Y=+^(0) D D^DGPTUTL
  1.  F PS2=1:1 Q:'$D(DGZPRF(DGZP,PS2))  S PS2(PS2)=DGZP_"^"_PS2
  1.  S PS2=PS2-1
  1. QQ S DIR("A")="Select CPT code to Delete <1 - "_PS2_">",DIR(0)="NO^^K:X<1!(X>"_PS2_") X" D ^DIR K DIR G ^DGPTFM:$D(DIRUT),^DGPTFM:'Y
  1. QQA S A1=Y,DGZP=+PS2(A1),CPT=+DGZPRF(DGZP,$P(PS2(A1),U,2))
  1.  S DIR("A")="Are you sure you want to delete CPT code '"
  1.  I $D(^ICPT(CPT)) D
  1.  .S N=$$CPT^ICPTCOD(CPT,$$GETDATE^ICDGTDRG(PTF))
  1.  .S N=$S(N>0:$P(N,U,2,99),1:"")
  1.  .S DIR("A")=DIR("A")_$P(N,U)_" "_$P(N,U,2)_"'"
  1.  E  S DIR("A")=DIR("A")_CPT_"  UNKNOWN"
  1.  S DIR(0)="Y",DIR("B")="No" D ^DIR K DIR G ^DGPTFM:'Y
  1.  G ^DGPTFM:'$$LOCK
  1. QEL D NOW^%DTC S DA=DGZPRF(DGZP,$P(PS2(A1),U,2),0),DR="1////^S X=%"
  1.  S REC=DGZPRF(DGZP,0)
  1.  S DIE="^DGCPT(46," D FMDIE K A1,DR W !!,"CPT Code....Deleted"
  1.  I '$D(DGZPRF(DGZP,2)) S DR=".09////1",DIE="^DGPT("_PTF_",""C"",",DA=DGZPRF(DGZP,0),DA(1)=PTF D ^DIE
  1.  I $D(DGZPRF(DGZP,2)) D PCE^DGPTFQWK
  1.  L -^DGPT(PTF) W:$X>70 ! D MOB H 2 G ^DGPTFM
  1. F D MOB S DGZP=$S($E($G(ANS),2,99):+$E($G(ANS),2,99),1:1) G SET
  1. MOB S (H,I,N)=0 K DGZPRF F M=1:1:6 S:$D(SDCLY(M)) N=N+1
  1.  F I2=1:1 S H=$O(^DGPT(PTF,"C","B",H)) Q:H'>0  D
  1.  .F  S I=$O(^DGPT(PTF,"C","B",H,I)) Q:I'>0  D
  1.  ..S DGZPRF(I2)=^DGPT(PTF,"C",I,0),DGZPRF(I2,0)=I,(K,K1)=0,F=1 D
  1.  ...F  S K=$O(^DGCPT(46,"C",PTF,K)),L=N+1\2+3 Q:K'>0  I +DGZPRF(I2)=+$G(^DGCPT(46,K,1)),'$G(^DGCPT(46,K,9)) D
  1.  ....S K1=K1+1,DGZPRF(I2,K1)=^(0),DGZPRF(I2,K1,0)=K,F=0
  1.  ....F M=2,3,5,6,7,15,16,17,18 S:$P(DGZPRF(I2,K1),U,M) L=L+1
  1.  ....S DGZPRF(I2,K1,1)=L
  1.  ...I F,$G(DGPSM)'=DGZPRF(I2,0) K DGZPRF(I2) S I2=I2-1
  1.  S DGZPRF="1^1^"_(I2-1) K F,I,K,K1,N Q
  1. SED S DR=".14////"_DGPRD_";.16////"_PTF_";",(DA,REC)=+Y,DIE="^DGCPT(46," D GETINFO^DGPTFM21 Q
  1. FMDIE ;Prompt user for questions and file answers (using DIE)
  1.  D ^DIE Q:$D(Y)>9  S RES=$$DELVFILE^DGAPI1(DFN,PTF,DGZP) K DIE,REC Q
  1. LOCK() L +^DGPT(PTF):2 I  Q 1
  1. ERR W !,"CPT Record is being edited by another user" K DIE,REC H 2 Q 0