- PSBOMT1 ;BIRMINGHAM/TEJ-BCMA MEDICATION THERAPY REPORT ;Mar 2004
- ;;3.0;BAR CODE MED ADMIN;**32**;Mar 2004;Build 32
- ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
- ;
- ; Reference/IA
- ; File 50.7/2880
- ; File 52.6/436
- ; File 52.7/437
- ; File 200/10060
- ; EN^PSJBCMA1/2829
- ; IEN^PSN50P65/4543
- ; DRGIEN^PSS50P7/4662
- ; VAC^PSS50/4533
- GETADSO ; GET ALL ADDITIVES FOR ALL ORDERABLE ITEMS
- K PSBAOUT,PSBSOUT
- S XA="" F S XA=$O(PSBOIP("OIP",XA)) Q:XA="" D
- .D LIST^DIC(52.6,"","@;15I","QPI","","","","AOI","","","PSBAOUT")
- .S XB=0 F S XB=$O(PSBAOUT("DILIST",XB)) Q:XB="" D
- ..I $P(PSBAOUT("DILIST",XB,0),"^",2)=XA D
- ...S TMP("PSBADDS",$J,$P(PSBAOUT("DILIST",XB,0),"^",1))=""
- K PSBAOUT
- ; GET ALL SOLUTIONS FOR ALL ORDERABLE ITEMS
- S XA="" F S XA=$O(PSBOIP("OIP",XA)) Q:XA="" D
- .D LIST^DIC(52.7,"","@;9I","QPI","","","","AOI","","","PSBSOUT")
- .S XB=0 F S XB=$O(PSBSOUT("DILIST",XB)) Q:XB="" D
- ..I $P(PSBSOUT("DILIST",XB,0),"^",2)=XA D
- ...S TMP("PSBSOLS",$J,$P(PSBSOUT("DILIST",XB,0),"^",1))=""
- K PSBSOUT
- Q
- FINDIENS ; USE PSBOIS,PSBADDS AND PSBSOLS TO FIND ALL IENS FOR THE RPT
- ;SEARCH FOR UNIT DOSE IENS
- I $D(TMP("PSBOIS",$J)) S XA="" F S XA=$O(TMP("PSBOIS",$J,XA)) Q:XA="" D
- .S PSBDT=PSBSTRT F S PSBDT=$O(^PSB(53.79,"AOIP",PSBXDFN,XA,PSBDT)) Q:PSBDT=""!(PSBDT>PSBSTOP) D
- ..S PSBIEN="" F S PSBIEN=$O(^PSB(53.79,"AOIP",PSBXDFN,XA,PSBDT,PSBIEN)) Q:PSBIEN="" D
- ...Q:$P(^PSB(53.79,PSBIEN,0),U,9)="N"
- ...S TMP("PSBIENS",$J,$$GET1^DIQ(53.79,PSBIEN_",",.06,"I"),PSBIEN)=""
- ;SEARCH FOR ADDITIVES
- I $D(TMP("PSBADDS",$J)) S XA="" F S XA=$O(TMP("PSBADDS",$J,XA)) Q:XA="" D
- .S PSBIEN="" F S PSBIEN=$O(^PSB(53.79,"AOIP3",PSBXDFN,PSBIEN)) Q:PSBIEN="" D
- ..S XB="" F S XB=$O(^PSB(53.79,"AOIP3",PSBXDFN,PSBIEN,XB)) Q:XB="" D
- ...Q:XB'=XA
- ...Q:$P(^PSB(53.79,PSBIEN,0),U,9)="N"
- ...I $P(^PSB(53.79,PSBIEN,0),"^",6)>PSBSTRT,($P(^PSB(53.79,PSBIEN,0),"^",6)<PSBSTOP) D
- ....S TMP("PSBIENS",$J,$$GET1^DIQ(53.79,PSBIEN_",",.06,"I"),PSBIEN)=""
- ;SEARCH FOR SOLUTIONS
- I $D(TMP("PSBSOLS",$J)) S XA="" F S XA=$O(TMP("PSBSOLS",$J,XA)) Q:XA="" D
- .S PSBIEN="" F S PSBIEN=$O(^PSB(53.79,"AOIP4",PSBXDFN,PSBIEN)) Q:PSBIEN="" D
- ..S XB="" F S XB=$O(^PSB(53.79,"AOIP4",PSBXDFN,PSBIEN,XB)) Q:XB="" D
- ...Q:XB'=XA
- ...Q:$P(^PSB(53.79,PSBIEN,0),U,9)="N"
- ...I $P(^PSB(53.79,PSBIEN,0),"^",6)>PSBSTRT,($P(^PSB(53.79,PSBIEN,0),"^",6)<PSBSTOP) D
- ....S TMP("PSBIENS",$J,$$GET1^DIQ(53.79,PSBIEN_",",.06,"I"),PSBIEN)=""
- Q
- HDR ; Header
- W:$Y>1 @IOF
- W:$X>1 !
- S PSBRPNM="BCMA MEDICATION THERAPY REPORT"
- S PSBPGNUM=1,PSBOUTP(0)="",PSBRPT(0)=""
- S PSBPG="Page: "_PSBPGNUM_" of "_$S($O(PSBOUTP(""),-1)=0:1,1:$O(PSBOUTP(""),-1))
- I $P(PSBRPT(0),U,4)="" S $P(PSBRPT(0),U,4)=DUZ(2)
- S PSBPGRM=IOM-($L(PSBPG))
- D:$P(PSBRPT(.1),U,1)="P"
- .K PSBHDR
- .S PSBHDR(1)="BCMA MEDICATION THERAPY REPORT for "
- .S Y=$P(PSBRPT(.1),U,6) D D^DIQ S PSBHDR(1)=PSBHDR(1)_Y_"@" S Y=$P(PSBRPT(.1),U,7) S PSBHDR(1)=PSBHDR(1)_$E(Y_"0000",2,5)_" to "
- .S Y=$P(PSBRPT(.1),U,8) D D^DIQ S PSBHDR(1)=PSBHDR(1)_Y_"@" S Y=$P(PSBRPT(.1),U,9) S PSBHDR(1)=PSBHDR(1)_$E(Y_"0000",2,5)
- .S PSBHDR(2)="Schedule Type(s): --"
- .F Y=1:1:4 I $P(PSBRPT(.2),U,Y) S $P(PSBHDR(2),": ",2)=$P(PSBHDR(2),": ",2)_$S(PSBHDR(2)["--":"",1:"/ ")_$P("Continuous^PRN^On-Call^One-Time",U,Y)_" " S PSBHDR(2)=$TR(PSBHDR(2),"-","")
- .I PSBCFLG S PSBHDR(3)="Include Comments" S PSBHDR(4)=" "
- .E S PSBHDR(3)=" "
- Q
- LEGEND ; Report Legend
- K PSBLGDO
- S PSBLGD("ORDER TYPES","C")="Continuous"
- S PSBLGD("ORDER TYPES","O")="One Time"
- S PSBLGD("ORDER TYPES","OC")="On Call"
- S PSBLGD("ORDER TYPES","P")="PRN (As Needed)"
- S PSB=0 F S PSB=$O(PSBLGD("INITIALS",PSB)) Q:+PSB=0 D
- .S PSBINIT=$$GET1^DIQ(200,PSB_",","INITIAL"),PSBLGD("INITIALS",$S(PSBINIT']" ":"*n/a*",1:PSBINIT))=$$GET1^DIQ(200,PSB_",","NAME")
- .K PSBLGD("INITIALS",PSB)
- S PSBLGDO(0)="REPORT LEGEND"
- S PSBLGDO(1)=""
- S PSBLGDO(2)=$S($G(PSBNO,0):"",1:"SCHEDULE TYPES")
- S PSBLGDO(3)=""
- I '$G(PSBNO,0) S X1="",X2=3 F S X1=$O(PSBLGD("ORDER TYPES",X1)) Q:X1="" S X2=X2+1,PSBLGDO(X2)=X1,$E(PSBLGDO(X2),5)="- "_PSBLGD("ORDER TYPES",X1)
- I $D(PSBLGD("INITIALS")) S $E(PSBLGDO(2),35)="INITIALS" S X1="",X2=3 F S X1=$O(PSBLGD("INITIALS",X1)) Q:X1="" S X2=X2+1,$E(PSBLGDO(X2),35)=X1,$E(PSBLGDO(X2),40)="- "_PSBLGD("INITIALS",X1)
- I ($Y+$O(PSBLGDO(""),-1))>(IOSL-12) D
- .W $$PTFTR^PSBOHDR()
- .D PT^PSBOHDR(PSBXDFN,.PSBHDR)
- I IOSL<1000 F Q:($Y+$O(PSBLGDO(""),-1)+12)>IOSL W !
- W !,$TR($J("",IOM)," ","="),!
- F X1=$O(PSBLGDO("")):1:$O(PSBLGDO(""),-1) W !,PSBLGDO(X1)
- W !!,$TR($J("",IOM)," ","="),!
- Q
- FTR ;
- I (IOSL<100) F Q:$Y>(IOSL-6) W !
- W !,$TR($J("",IOM)," ","=")
- S X="Ward: "_PSBHDR("WARD")_" Room-Bed: "_PSBHDR("ROOM")
- W !,PSBHDR("NAME"),?(IOM-11\2),PSBHDR("SSN"),?(IOM-$L(X)),X
- W !,"BCMA MEDICATION THERAPY REPORT",?(IOM-$L(PSBDTTM)),PSBDTTM
- Q
- MAKELINE(X,CNT) ;LINE OF WHAT'S PASSED IN CNT TIMES
- N Y,Z
- S Y=""
- F Z=1:1:CNT S Y=Y_X
- Q Y
- ;
- PARSE(X,CNT) ;Split text for wrapping.
- S CNTX="UOA"_CNT,@CNTX=@CNTX_$E(X,CNT,(CNT+14)),UOAX=""
- F S:$F(@CNTX,", ",+UOAX)>0 UOAX=$F(@CNTX,", ",+UOAX) Q:'$F(@CNTX,", ",+UOAX)
- I UOAX<1 F S:$F(@CNTX," ",+UOAX)>0 UOAX=$F(@CNTX," ",+UOAX) Q:'$F(@CNTX," ",+UOAX)
- I UOAX>1,(($L(UOA)-(CNT+14))>0) S CNTXX=$E(@CNTX,1,UOAX-1),@("UOA"_(CNT+15))=$E(@CNTX,UOAX,UOAX+14),@CNTX=CNTXX
- Q
- ;
- PAD(X,CNT) ;
- Q $E(X_$J("",CNT),1,CNT)
- ;
- CLEANALL ; KILL ALL TMP LEVELS USED VARIABLES
- K ^TMP("PSB",$J),^TMP("PSJ1",$J),PSBOIP,TMP("PSBADDS",$J),TMP("PSBSOLS",$J)
- K TMP("PSBIENS",$J)
- Q
- ;
- CLEANSUM ; KILL ALL BUN THE "PSBIENS" LEVEL
- K ^TMP("PSB",$J),^TMP("PSJ1",$J),TMP("PSBIENS",$J),TMP("PSBOIS",$J),TMP("PSBADDS",$J),TMP("PSBSOLS",$J)
- Q
- PSBOMT1 ;BIRMINGHAM/TEJ-BCMA MEDICATION THERAPY REPORT ;Mar 2004
- +1 ;;3.0;BAR CODE MED ADMIN;**32**;Mar 2004;Build 32
- +2 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
- +3 ;
- +4 ; Reference/IA
- +5 ; File 50.7/2880
- +6 ; File 52.6/436
- +7 ; File 52.7/437
- +8 ; File 200/10060
- +9 ; EN^PSJBCMA1/2829
- +10 ; IEN^PSN50P65/4543
- +11 ; DRGIEN^PSS50P7/4662
- +12 ; VAC^PSS50/4533
- GETADSO ; GET ALL ADDITIVES FOR ALL ORDERABLE ITEMS
- +1 KILL PSBAOUT,PSBSOUT
- +2 SET XA=""
- FOR
- SET XA=$ORDER(PSBOIP("OIP",XA))
- IF XA=""
- QUIT
- Begin DoDot:1
- +3 DO LIST^DIC(52.6,"","@;15I","QPI","","","","AOI","","","PSBAOUT")
- +4 SET XB=0
- FOR
- SET XB=$ORDER(PSBAOUT("DILIST",XB))
- IF XB=""
- QUIT
- Begin DoDot:2
- +5 IF $PIECE(PSBAOUT("DILIST",XB,0),"^",2)=XA
- Begin DoDot:3
- +6 SET TMP("PSBADDS",$JOB,$PIECE(PSBAOUT("DILIST",XB,0),"^",1))=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +7 KILL PSBAOUT
- +8 ; GET ALL SOLUTIONS FOR ALL ORDERABLE ITEMS
- +9 SET XA=""
- FOR
- SET XA=$ORDER(PSBOIP("OIP",XA))
- IF XA=""
- QUIT
- Begin DoDot:1
- +10 DO LIST^DIC(52.7,"","@;9I","QPI","","","","AOI","","","PSBSOUT")
- +11 SET XB=0
- FOR
- SET XB=$ORDER(PSBSOUT("DILIST",XB))
- IF XB=""
- QUIT
- Begin DoDot:2
- +12 IF $PIECE(PSBSOUT("DILIST",XB,0),"^",2)=XA
- Begin DoDot:3
- +13 SET TMP("PSBSOLS",$JOB,$PIECE(PSBSOUT("DILIST",XB,0),"^",1))=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +14 KILL PSBSOUT
- +15 QUIT
- FINDIENS ; USE PSBOIS,PSBADDS AND PSBSOLS TO FIND ALL IENS FOR THE RPT
- +1 ;SEARCH FOR UNIT DOSE IENS
- +2 IF $DATA(TMP("PSBOIS",$JOB))
- SET XA=""
- FOR
- SET XA=$ORDER(TMP("PSBOIS",$JOB,XA))
- IF XA=""
- QUIT
- Begin DoDot:1
- +3 SET PSBDT=PSBSTRT
- FOR
- SET PSBDT=$ORDER(^PSB(53.79,"AOIP",PSBXDFN,XA,PSBDT))
- IF PSBDT=""!(PSBDT>PSBSTOP)
- QUIT
- Begin DoDot:2
- +4 SET PSBIEN=""
- FOR
- SET PSBIEN=$ORDER(^PSB(53.79,"AOIP",PSBXDFN,XA,PSBDT,PSBIEN))
- IF PSBIEN=""
- QUIT
- Begin DoDot:3
- +5 IF $PIECE(^PSB(53.79,PSBIEN,0),U,9)="N"
- QUIT
- +6 SET TMP("PSBIENS",$JOB,$$GET1^DIQ(53.79,PSBIEN_",",.06,"I"),PSBIEN)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +7 ;SEARCH FOR ADDITIVES
- +8 IF $DATA(TMP("PSBADDS",$JOB))
- SET XA=""
- FOR
- SET XA=$ORDER(TMP("PSBADDS",$JOB,XA))
- IF XA=""
- QUIT
- Begin DoDot:1
- +9 SET PSBIEN=""
- FOR
- SET PSBIEN=$ORDER(^PSB(53.79,"AOIP3",PSBXDFN,PSBIEN))
- IF PSBIEN=""
- QUIT
- Begin DoDot:2
- +10 SET XB=""
- FOR
- SET XB=$ORDER(^PSB(53.79,"AOIP3",PSBXDFN,PSBIEN,XB))
- IF XB=""
- QUIT
- Begin DoDot:3
- +11 IF XB'=XA
- QUIT
- +12 IF $PIECE(^PSB(53.79,PSBIEN,0),U,9)="N"
- QUIT
- +13 IF $PIECE(^PSB(53.79,PSBIEN,0),"^",6)>PSBSTRT
- IF ($PIECE(^PSB(53.79,PSBIEN,0),"^",6)<PSBSTOP)
- Begin DoDot:4
- +14 SET TMP("PSBIENS",$JOB,$$GET1^DIQ(53.79,PSBIEN_",",.06,"I"),PSBIEN)=""
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 ;SEARCH FOR SOLUTIONS
- +16 IF $DATA(TMP("PSBSOLS",$JOB))
- SET XA=""
- FOR
- SET XA=$ORDER(TMP("PSBSOLS",$JOB,XA))
- IF XA=""
- QUIT
- Begin DoDot:1
- +17 SET PSBIEN=""
- FOR
- SET PSBIEN=$ORDER(^PSB(53.79,"AOIP4",PSBXDFN,PSBIEN))
- IF PSBIEN=""
- QUIT
- Begin DoDot:2
- +18 SET XB=""
- FOR
- SET XB=$ORDER(^PSB(53.79,"AOIP4",PSBXDFN,PSBIEN,XB))
- IF XB=""
- QUIT
- Begin DoDot:3
- +19 IF XB'=XA
- QUIT
- +20 IF $PIECE(^PSB(53.79,PSBIEN,0),U,9)="N"
- QUIT
- +21 IF $PIECE(^PSB(53.79,PSBIEN,0),"^",6)>PSBSTRT
- IF ($PIECE(^PSB(53.79,PSBIEN,0),"^",6)<PSBSTOP)
- Begin DoDot:4
- +22 SET TMP("PSBIENS",$JOB,$$GET1^DIQ(53.79,PSBIEN_",",.06,"I"),PSBIEN)=""
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 QUIT
- HDR ; Header
- +1 IF $Y>1
- WRITE @IOF
- +2 IF $X>1
- WRITE !
- +3 SET PSBRPNM="BCMA MEDICATION THERAPY REPORT"
- +4 SET PSBPGNUM=1
- SET PSBOUTP(0)=""
- SET PSBRPT(0)=""
- +5 SET PSBPG="Page: "_PSBPGNUM_" of "_$SELECT($ORDER(PSBOUTP(""),-1)=0:1,1:$ORDER(PSBOUTP(""),-1))
- +6 IF $PIECE(PSBRPT(0),U,4)=""
- SET $PIECE(PSBRPT(0),U,4)=DUZ(2)
- +7 SET PSBPGRM=IOM-($LENGTH(PSBPG))
- +8 IF $PIECE(PSBRPT(.1),U,1)="P"
- Begin DoDot:1
- +9 KILL PSBHDR
- +10 SET PSBHDR(1)="BCMA MEDICATION THERAPY REPORT for "
- +11 SET Y=$PIECE(PSBRPT(.1),U,6)
- DO D^DIQ
- SET PSBHDR(1)=PSBHDR(1)_Y_"@"
- SET Y=$PIECE(PSBRPT(.1),U,7)
- SET PSBHDR(1)=PSBHDR(1)_$EXTRACT(Y_"0000",2,5)_" to "
- +12 SET Y=$PIECE(PSBRPT(.1),U,8)
- DO D^DIQ
- SET PSBHDR(1)=PSBHDR(1)_Y_"@"
- SET Y=$PIECE(PSBRPT(.1),U,9)
- SET PSBHDR(1)=PSBHDR(1)_$EXTRACT(Y_"0000",2,5)
- +13 SET PSBHDR(2)="Schedule Type(s): --"
- +14 FOR Y=1:1:4
- IF $PIECE(PSBRPT(.2),U,Y)
- SET $PIECE(PSBHDR(2),": ",2)=$PIECE(PSBHDR(2),": ",2)_$SELECT(PSBHDR(2)["--":"",1:"/ ")_$PIECE("Continuous^PRN^On-Call^One-Time",U,Y)_" "
- SET PSBHDR(2)=$TRANSLATE(PSBHDR(2),"-","")
- +15 IF PSBCFLG
- SET PSBHDR(3)="Include Comments"
- SET PSBHDR(4)=" "
- +16 IF '$TEST
- SET PSBHDR(3)=" "
- End DoDot:1
- +17 QUIT
- LEGEND ; Report Legend
- +1 KILL PSBLGDO
- +2 SET PSBLGD("ORDER TYPES","C")="Continuous"
- +3 SET PSBLGD("ORDER TYPES","O")="One Time"
- +4 SET PSBLGD("ORDER TYPES","OC")="On Call"
- +5 SET PSBLGD("ORDER TYPES","P")="PRN (As Needed)"
- +6 SET PSB=0
- FOR
- SET PSB=$ORDER(PSBLGD("INITIALS",PSB))
- IF +PSB=0
- QUIT
- Begin DoDot:1
- +7 SET PSBINIT=$$GET1^DIQ(200,PSB_",","INITIAL")
- SET PSBLGD("INITIALS",$SELECT(PSBINIT']" ":"*n/a*",1:PSBINIT))=$$GET1^DIQ(200,PSB_",","NAME")
- +8 KILL PSBLGD("INITIALS",PSB)
- End DoDot:1
- +9 SET PSBLGDO(0)="REPORT LEGEND"
- +10 SET PSBLGDO(1)=""
- +11 SET PSBLGDO(2)=$SELECT($GET(PSBNO,0):"",1:"SCHEDULE TYPES")
- +12 SET PSBLGDO(3)=""
- +13 IF '$GET(PSBNO,0)
- SET X1=""
- SET X2=3
- FOR
- SET X1=$ORDER(PSBLGD("ORDER TYPES",X1))
- IF X1=""
- QUIT
- SET X2=X2+1
- SET PSBLGDO(X2)=X1
- SET $EXTRACT(PSBLGDO(X2),5)="- "_PSBLGD("ORDER TYPES",X1)
- +14 IF $DATA(PSBLGD("INITIALS"))
- SET $EXTRACT(PSBLGDO(2),35)="INITIALS"
- SET X1=""
- SET X2=3
- FOR
- SET X1=$ORDER(PSBLGD("INITIALS",X1))
- IF X1=""
- QUIT
- SET X2=X2+1
- SET $EXTRACT(PSBLGDO(X2),35)=X1
- SET $EXTRACT(PSBLGDO(X2),40)="- "_PSBLGD("INITIALS",X1)
- +15 IF ($Y+$ORDER(PSBLGDO(""),-1))>(IOSL-12)
- Begin DoDot:1
- +16 WRITE $$PTFTR^PSBOHDR()
- +17 DO PT^PSBOHDR(PSBXDFN,.PSBHDR)
- End DoDot:1
- +18 IF IOSL<1000
- FOR
- IF ($Y+$ORDER(PSBLGDO(""),-1)+12)>IOSL
- QUIT
- WRITE !
- +19 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","="),!
- +20 FOR X1=$ORDER(PSBLGDO("")):1:$ORDER(PSBLGDO(""),-1)
- WRITE !,PSBLGDO(X1)
- +21 WRITE !!,$TRANSLATE($JUSTIFY("",IOM)," ","="),!
- +22 QUIT
- FTR ;
- +1 IF (IOSL<100)
- FOR
- IF $Y>(IOSL-6)
- QUIT
- WRITE !
- +2 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","=")
- +3 SET X="Ward: "_PSBHDR("WARD")_" Room-Bed: "_PSBHDR("ROOM")
- +4 WRITE !,PSBHDR("NAME"),?(IOM-11\2),PSBHDR("SSN"),?(IOM-$LENGTH(X)),X
- +5 WRITE !,"BCMA MEDICATION THERAPY REPORT",?(IOM-$LENGTH(PSBDTTM)),PSBDTTM
- +6 QUIT
- MAKELINE(X,CNT) ;LINE OF WHAT'S PASSED IN CNT TIMES
- +1 NEW Y,Z
- +2 SET Y=""
- +3 FOR Z=1:1:CNT
- SET Y=Y_X
- +4 QUIT Y
- +5 ;
- PARSE(X,CNT) ;Split text for wrapping.
- +1 SET CNTX="UOA"_CNT
- SET @CNTX=@CNTX_$EXTRACT(X,CNT,(CNT+14))
- SET UOAX=""
- +2 FOR
- IF $FIND(@CNTX,", ",+UOAX)>0
- SET UOAX=$FIND(@CNTX,", ",+UOAX)
- IF '$FIND(@CNTX,", ",+UOAX)
- QUIT
- +3 IF UOAX<1
- FOR
- IF $FIND(@CNTX," ",+UOAX)>0
- SET UOAX=$FIND(@CNTX," ",+UOAX)
- IF '$FIND(@CNTX," ",+UOAX)
- QUIT
- +4 IF UOAX>1
- IF (($LENGTH(UOA)-(CNT+14))>0)
- SET CNTXX=$EXTRACT(@CNTX,1,UOAX-1)
- SET @("UOA"_(CNT+15))=$EXTRACT(@CNTX,UOAX,UOAX+14)
- SET @CNTX=CNTXX
- +5 QUIT
- +6 ;
- PAD(X,CNT) ;
- +1 QUIT $EXTRACT(X_$JUSTIFY("",CNT),1,CNT)
- +2 ;
- CLEANALL ; KILL ALL TMP LEVELS USED VARIABLES
- +1 KILL ^TMP("PSB",$JOB),^TMP("PSJ1",$JOB),PSBOIP,TMP("PSBADDS",$JOB),TMP("PSBSOLS",$JOB)
- +2 KILL TMP("PSBIENS",$JOB)
- +3 QUIT
- +4 ;
- CLEANSUM ; KILL ALL BUN THE "PSBIENS" LEVEL
- +1 KILL ^TMP("PSB",$JOB),^TMP("PSJ1",$JOB),TMP("PSBIENS",$JOB),TMP("PSBOIS",$JOB),TMP("PSBADDS",$JOB),TMP("PSBSOLS",$JOB)
- +2 QUIT
