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

PXBPPOV1.m

Go to the documentation of this file.
  1. PXBPPOV1 ;ISL/JVS,ESW - PROMPT POV ;4/6/05 2:41pm
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,112,121,124,199**;Aug 12, 1996;Build 51
  1. ;
  1. ;
  1. ;
  1. ;
  1. ;
  1. ADDM ;--------If Multiple POV entries have been entered.
  1. ;
  1. ;
  1. ;
  1. N BDATA,OK,PXBLEN,PXDXDATE
  1. S PXDXDATE=$$CSDATE^PXDXUTL(PXBVST)
  1. D WIN17^PXBCC(PXBCNT)
  1. S NF=0,PXBLEN=0
  1. I DATA[",",$E(DATA,1)'["@" S NF=1 D
  1. .S PXBLEN=$L(DATA,",") F PXI=1:1:PXBLEN S PXBPIECE=$P(DATA,",",PXI) D
  1. ..S Y=$$ICDDATA^ICDXCODE("DIAG",PXBPIECE,PXDXDATE,"E")
  1. ..I $P(Y,U)=-1!($P(Y,U,10)'=1) S BAD($G(PXBPIECE))="" Q
  1. ..S $P(REQI,"^",5)=+Y
  1. ..S PXBNPOV(PXBPIECE)=""
  1. ..;
  1. ..;--Prompt for Primary or Secondary DIAGNOSIS
  1. ..; ICD-10 Remediation note: the next two lines display code--code (ex. 369.65--369.65)
  1. ..; we think this is wrong but do not have specs to fix it.
  1. ..W !,"For the DIAGNOSIS: ",PXBPIECE,"--"
  1. ..W $P(Y,U,2),!
  1. ..D WIN17^PXBCC(PXBCNT)
  1. ..D PRI^PXBPPOV1
  1. ..I $D(DIRUT) D RSET^PXBDREQ("POV") Q
  1. ..D ORD^PXBPPOV1
  1. ..N PXCEVIEN,PXCEAFTR,PXD
  1. ..S PXCEVIEN=PXBVST,PXD=$P(REQI,U,5)
  1. ..D WIN17^PXBCC(PXBCNT),GET800^PXCEC800 ;CI's
  1. ..S PXBREQ(PXD,"I")=$G(PXCEAFTR(800))
  1. ..;
  1. ..D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
  1. ..D EN1^PXKMAIN
  1. ..D RSET^PXBDREQ("POV")
  1. I $G(NF)&($D(BAD)) D Q
  1. .S (BDATA,EDATA)="" F S BDATA=$O(BAD(BDATA)) Q:BDATA="" S EDATA=EDATA_BDATA_" "
  1. .W ! D HELP^PXBUTL0("CPTM") W !
  1. .S DIR(0)="E" D ^DIR K DIR,DIRUT
  1. .S:Y=1 DATA="^P" S:Y=0!(Y="") DATA="^" K Y
  1. I $G(NF)&('$D(BAD)) S DATA="^P" Q
  1. ;
  1. Q
  1. ;
  1. DELM ;--------If Multiple deleting
  1. N BAD,BDATA,DELM,PXBJ,PXBLEN
  1. S NF=0,PXBLEN=0 S $P(DELM,"^",3)=1
  1. I $E(DATA,1)="@" S DATA=$P(DATA,"@",2),NF=1 D
  1. .S PXBLEN=$L(DATA,",") F PXI=1:1:PXBLEN S PXBPIECE=$P(DATA,",",PXI) D
  1. ..I PXBPIECE'["-"&(PXBPIECE'>0!(PXBPIECE'<(PXBCNT+1))) S BAD(+$G(PXBPIECE))="" Q
  1. ..I PXBPIECE'["-" D
  1. ...I $D(GONE(PXBPIECE)) Q
  1. ...Q:PXBPIECE'?.N
  1. ...S $P(REQI,"^",9)=$O(PXBSKY(PXBPIECE,0)) ;-IEN
  1. ...S X=$P(PXBSAM(PXBPIECE),U,1),Y=$$ICDDATA^ICDXCODE("DIAG",X,PXDXDATE,"E")
  1. ...I $P(Y,U)'=-1&($P(Y,U,10)=1) D
  1. ....S $P(REQI,"^",5)=+Y K Y
  1. ....S GONE(PXBPIECE)=""
  1. ....D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
  1. ....D EN1^PXKMAIN
  1. ..I PXBPIECE["-" D
  1. ...F PXBJ=$P(PXBPIECE,"-",1):1:$P(PXBPIECE,"-",2) D
  1. ....I $D(GONE(PXBJ)) Q
  1. ....I PXBJ'>0!(PXBJ'<(PXBCNT+1)) S BAD(PXBJ)="" Q
  1. ....S $P(REQI,"^",9)=$O(PXBSKY(PXBJ,0)) ;-IEN
  1. ....S X=$P(PXBSAM(PXBJ),U,1),Y=$$ICDDATA^ICDXCODE("DIAG",X,PXDXDATE,"E")
  1. ....I $P(Y,U)'=-1&($P(Y,U,10)=1) D
  1. .....S $P(REQI,"^",5)=+Y K Y
  1. .....S GONE(PXBJ)=""
  1. .....D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
  1. .....D EN1^PXKMAIN
  1. K GONE
  1. I $G(NF)&($D(BAD)) D Q
  1. .S (BDATA,EDATA)="" F S BDATA=$O(BAD(BDATA)) Q:BDATA="" S EDATA=EDATA_BDATA_" "
  1. .W ! D HELP^PXBUTL0("CPTMD") W !
  1. .S DIR(0)="E" D ^DIR K DIR
  1. .S:Y=1 DATA="^P" S:Y=0!(Y="") DATA="^" K Y
  1. I $G(NF)&('$D(BAD)) S DATA="^P" Q
  1. Q
  1. PRI ;--Prompt for primary secondary DIAGNOSIS
  1. N DIR,Y,X,SEQ
  1. S SEQ=0 I $D(PXBKY(DATA)) S SEQ=+$O(PXBKY(DATA,"")) ;PX112
  1. I $G(FPRI),$P($G(PXBKY(DATA,SEQ)),U,4)'="PRIMARY" Q ;PX112
  1. W IOCUD,IOELALL,IOCUU
  1. S DIR("A",1)="ONE primary diagnosis must be established for each encounter!"
  1. S DIR("A")="Is this the PRIMARY DIAGNOSIS for this ENCOUNTER? "
  1. S DIR("B")="YES"
  1. S DIR("?")="One PRIMARY DIAGNOSIS must be established for each patient encounter. 'Yes' will mean PRIMARY and 'No' will mean SECONDARY."
  1. S DIR(0)="Y,A,O"
  1. D ^DIR I $G(DIRUT) G PPXIT
  1. PPFIN ;--Finish off variables
  1. I Y=1 S PRI="P^PRIMARY"
  1. I Y=0 S PRI="S^SECONDARY"
  1. S $P(REQI,"^",6)=$P(PRI,"^",1)
  1. S $P(REQE,"^",6)=$P(PRI,"^",2)
  1. PPXIT ;--EXIT
  1. Q
  1. ORD ;--Prompt for ordering resulting DIAGNOSIS
  1. N DIR,Y,X,SEQ
  1. S SEQ=0 I $D(PXBKY(DATA)) S SEQ=+$O(PXBKY(DATA,""))
  1. W IOCUD,IOELALL,IOCUU
  1. S DIR("A")="Is this Diagnosis Ordering or Resulting:"
  1. S DIR("B")=$P($G(PXBKY(DATA,SEQ)),U,7)
  1. S DIR("?")="Resulting and/or Ordering indicators are only entered if at least one of each diagnosis type exists."
  1. S DIR(0)="SO^O:ORDERING;R:RESULTING;OR:BOTH O&R"
  1. D ^DIR I $G(DIRUT) G PPXIT
  1. ORFIN ;--Finish off variables
  1. S $P(REQI,"^",7)=Y
  1. S $P(REQE,"^",7)=$S(Y="O":"ORDERING",Y="R":"RESULTING",1:"BOTH O&R")
  1. Q
  1. PRBLM ;--Prompt for Problem list
  1. N DIR,Y,X,VALL
  1. W IOCUD,IOELALL,IOCUU
  1. D WIN17^PXBCC(PXBCNT)
  1. S DIR("?")="^S VALL=1,VALL=$$DOUBLE1^PXBGPL2(WHAT)"
  1. S DIR("A")="Do you want this DIAGNOSIS added to the PROBLEM LIST? "
  1. S DIR("B")="NO"
  1. S DIR(0)="Y,A,O"
  1. D ^DIR
  1. I X="+"!(X="-") S DIR("?")="D DPOV4^PXBDPL(X)"
  1. I $G(DIRUT) G PPXIT
  1. PRPFIN ;--Finish off variables
  1. K PXBKYPL,PXBSKYPL,PXBSAMPL,PXBCNTPL
  1. K ^TMP("PXBKYPL",$J),^TMP("PXBSAMPL",$J)
  1. S PXBPRBLM=+Y
  1. PRPXIT ;--EXIT
  1. Q
  1. ;