source: FOIAVistA/tag/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBPSTP1.m@ 628

PXBPSTP1 ;ISL/JVS - STOP CODE,ACTIVE,MULTIPLE ADD/DELETE ;7/24/96  08:24
 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
 ;
 ;
 ;
ACTIVE(REQI,REQE) ;---Check to see if stop code is active on visit date
 N STOPI,STOPE,VISIT,DR,DA,INACTIVE,OK
 S NOT=0
 S STOPI=$P(REQI,"^",10) ;--STOP CODE IEN IN STOP CODE FILE
 S STOPE=$P(REQE,"^",10) ;--STOP CODE EXTERNAL VALUE
 S VISIT=$P(IDATE,".",1) ;--VISIT DATE INTERNAL FORM
 S DIC=40.7,DR=2,DA=STOPI,DIQ="INACTIVE",DIQ(0)="IN" D EN^DIQ1
 I $D(INACTIVE),$G(INACTIVE(40.7,2,"I"))<VISIT S NOT=1
 I $G(NOT) W !,IOEDEOP,IORVON,"--INACTIVE!-",STOPE," was INACTIVE  on the date of this ENCOUNTER.",IORVOFF
 Q NOT
ADDM ;--------If Multiple STOP CODE entries have been entered.
 ;
 N OK,PXBLEN,BAD,BDATA
 S NF=0,PXBLEN=0
 I DATA'["," Q
 I $P(DATA,",",1)'>0,$P(DATA,",",1)'<(PXBCNT+(1)) Q
 I DATA[",",$E(DATA,1)'["@" S NF=1 D WAIT^DICD D
 .S PXBLEN=$L(DATA,",") F PXI=1:1:PXBLEN S PXBPIECE=$P(DATA,",",PXI) D
 ..S X=PXBPIECE,DIC=40.7,DIC(0)="IMZ" D ^DIC
 ..I Y=-1 S BAD(+$G(PXBPIECE))="" Q
 ..S $P(REQI,"^",10)=+Y
 ..S PXBNSTP(PXBPIECE)=""
 ..S PXBNSTP($P(Y,"^",2))=""
 ..D STP^PXBSTOR1
 ..D RSET^PXBDREQ("STP")
 I $G(NF)&($D(BAD)) D  Q
 .S (BDATA,EDATA)="" F  S BDATA=$O(BAD(BDATA)) Q:BDATA=""  S EDATA=EDATA_BDATA_"  "
 .W ! D HELP^PXBUTL0("CPTM") W !
 .S DIR(0)="E" D ^DIR K DIR,DIRUT
 .S:Y=1 DATA="^S" S:Y=0!(Y="") DATA="^" K Y
 I $G(NF)&('$D(BAD)) S DATA="^S" Q
 ;
 Q
 ;
DELM ;--------If Multiple deleting
 I DATA'["@" Q
 N DELM,PXBJ,BAD,PXBLEN,BDATA
 S NF=0,PXBLEN=0 S $P(DELM,"^",3)=1
 I $E(DATA,1)="@" S DATA=$P(DATA,"@",2),NF=1 D WAIT^DICD D
 .S PXBLEN=$L(DATA,",") F PXI=1:1:PXBLEN S PXBPIECE=$P(DATA,",",PXI) D
 ..I PXBPIECE'["-"&(PXBPIECE'>0!(PXBPIECE'<(PXBCNT+1))) S BAD(+$G(PXBPIECE))="" Q
 ..I PXBPIECE'["-" D
 ...I $D(GONE(PXBPIECE)) Q
 ...Q:PXBPIECE'?.N
 ...;S $P(REQI,"^",9)=$O(PXBSKY(PXBPIECE,0)) ;-IEN
 ...S $P(REQI,"^",10)="@"
 ...S $P(REQI,"^",11)=$O(PXBSKY(PXBPIECE,0))
 ...S GONE(PXBPIECE)=""
 ...D STP^PXBSTOR1
 ..I PXBPIECE["-" D
 ...I DATA'?.N1"-".N S BAD(PXBPIECE)="" Q
 ...F PXBJ=$P(PXBPIECE,"-",1):1:$P(PXBPIECE,"-",2) D
 ....I $D(GONE(PXBJ)) Q
 ....I PXBJ'>0!(PXBJ'<(PXBCNT+1)) S BAD(PXBJ)="" Q
 ....S $P(REQI,"^",10)="@"
 ....S $P(REQI,"^",11)=$O(PXBSKY(PXBJ,0))
 ....S GONE(PXBJ)=""
 ....D STP^PXBSTOR1
 K GONE
 I $G(NF)&($D(BAD)) D  Q
 .S (BDATA,EDATA)="" F  S BDATA=$O(BAD(BDATA)) Q:BDATA=""  S EDATA=EDATA_BDATA_"  "
 .W ! D HELP^PXBUTL0("CPTMD") W !
 .S DIR(0)="E" D ^DIR K DIR
 .S:Y=1 DATA="^S" S:Y=0!(Y="") DATA="^" K Y
 I $G(NF)&('$D(BAD)) S DATA="^S" Q
 Q
 ;
PROMPT(PXBCNT) ;--DETERMINE WHERE PROMPT SHOULD START
 ;
 N START,DIFF
 S START=$G(^TMP("PXBDSTP",$J,"START"))
 S DIFF=PXBCNT-START
 I DIFF<10 S LINE=DIFF+5
 I DIFF>9 S LINE=15
 Q LINE
 ;