PSSP134 ;REPORT OF REFORMATTED LOCAL POSSIBLE DOSES
;;1.0;PHARMACY DATA MANAGEMENT;**134**;9/30/97;Build 8
;
LOOP ;LOOP THROUGH DRUG FILE FOR ALL LOCAL POSSIBLE DOSES
N PSSDRUG,PSSLPD2,PSSNLPD,PSSLPDX,PSSXDT,X1,X2,X,PSSDRUGN
K ^XTMP("PSSP134")
S X1=DT,X2=90 D C^%DTC S PSSXDT=$G(X)
S ^XTMP("PSSP134",0)=PSSXDT_"^"_DT
S PSSDRUG=0 F S PSSDRUG=$O(^PSDRUG(PSSDRUG)) Q:'PSSDRUG D
.S PSSLPDX=0 F S PSSLPDX=$O(^PSDRUG(PSSDRUG,"DOS2",PSSLPDX)) Q:'PSSLPDX D
..S PSSLPD2=$P($G(^PSDRUG(PSSDRUG,"DOS2",PSSLPDX,0)),"^",1)
..I PSSLPD2="" Q
..S PSSNLPD=$$DOSE(PSSLPD2)
..S PSSDRUGN=$P($G(^PSDRUG(PSSDRUG,0)),"^")
..S ^XTMP("PSSP134",PSSDRUGN,PSSDRUG,PSSLPDX)=PSSLPD2_"^"_PSSNLPD
D REPORT
Q
;
DOSE(PSSDOSE) ;
N PSSCHAR,PSSXX,PSSDOSR
S (PSSXX,PSSDOSR)=""
F PSSXX=1:1:$L(PSSDOSE) D
.S PSSCHAR=$E(PSSDOSE,PSSXX)
.I PSSCHAR=".",$E(PSSDOSE,PSSXX+1),$E(PSSDOSR,$L(PSSDOSR))'?1N S PSSCHAR=0_PSSCHAR
.I PSSDOSR]"",$E(PSSDOSR,$L(PSSDOSR))?1N,PSSCHAR'?1N,"() -./%,"'[PSSCHAR S PSSDOSR=PSSDOSR_" "_PSSCHAR Q
.I PSSDOSR]"",$E(PSSDOSR,$L(PSSDOSR))'?1N,"() -./%,"'[$E(PSSDOSR,$L(PSSDOSR)),PSSCHAR?1N S PSSDOSR=PSSDOSR_" "_PSSCHAR Q
.I PSSDOSR]"",$E(PSSDOSR,$L(PSSDOSR))?1N,PSSCHAR'?1N S PSSDOSR=PSSDOSR_PSSCHAR Q
.I PSSDOSR]"",$E(PSSDOSR,$L(PSSDOSR))'?1N,PSSCHAR'?1N S PSSDOSR=PSSDOSR_PSSCHAR Q
.S PSSDOSR=PSSDOSR_PSSCHAR
.Q
Q PSSDOSR
;
REPORT ;REPORT OF LOCAL POSSIBLE DOSES BEFORE AND AFTER
N XMDUZ,XMSUB,XMTEXT,XMY,Y,PSSDT,PSSXDT,DIFROM,PSSI
K ^XTMP("PSSP134R")
S X1=DT,X2=90 D C^%DTC S PSSXDT=$G(X)
S ^XTMP("PSSP134R",0)=PSSXDT_"^"_DT
S XMDUZ="REFORMATTED LOCAL POSSIBLE DOSES",XMSUB="REFORMATTED LOCAL POSSIBLE DOSES",XMTEXT="^XTMP(""PSSP134R"","
I $D(^XUSEC("PSNMGR")) F PSSI=0:0 S PSSI=$O(^XUSEC("PSNMGR",PSSI)) Q:'PSSI S XMY(PSSI)=""
D NOW^%DTC S Y=% X ^DD("DD") S PSSDT=Y
S ^XTMP("PSSP134R",1)="REFORMATTED LOCAL POSSIBLE DOSES USING API ASSOCIATED WITH PSS*1.0*78"
S ^XTMP("PSSP134R",2)=PSSDT
S ^XTMP("PSSP134R",3)=""
N PSSLPD,PSSNLPD,PSSDRUG,PSSLPDX,PSSLPDD,PSSLINE,PSSXX,PSSDRUGN,PSSSPC,PSSX
;
S PSSXX=4,PSSLINE="",PSSSPC=""
F PSSX=1:1:50 S $E(PSSLINE,PSSXX)="-",$E(PSSSPC,PSSXX)=" "
S PSSDRUGN="" F S PSSDRUGN=$O(^XTMP("PSSP134",PSSDRUGN)) Q:PSSDRUGN="" D
.S PSSDRUG=0 F S PSSDRUG=$O(^XTMP("PSSP134",PSSDRUGN,PSSDRUG)) Q:'PSSDRUG D
..S ^XTMP("PSSP134R",PSSXX)=$P($G(^PSDRUG(PSSDRUG,0)),"^",1)_" (#"_PSSDRUG_")"
..S PSSXX=PSSXX+1
..S PSSLPDX=0 F S PSSLPDX=$O(^XTMP("PSSP134",PSSDRUGN,PSSDRUG,PSSLPDX)) Q:'PSSLPDX D
...S PSSLPDD=^XTMP("PSSP134",PSSDRUGN,PSSDRUG,PSSLPDX)
...S PSSLPD=$P(PSSLPDD,"^"),PSSNLPD=$P(PSSLPDD,"^",2)
...S ^XTMP("PSSP134R",PSSXX)=$E(PSSSPC,1,10)_PSSLPD
...S ^XTMP("PSSP134R",PSSXX+1)=$E(PSSSPC,1,10)_PSSNLPD
...S ^XTMP("PSSP134R",PSSXX+2)=""
...S PSSXX=PSSXX+3
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSP134 2802 printed Nov 22, 2024@17:43:35 Page 2
PSSP134 ;REPORT OF REFORMATTED LOCAL POSSIBLE DOSES
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**134**;9/30/97;Build 8
+2 ;
LOOP ;LOOP THROUGH DRUG FILE FOR ALL LOCAL POSSIBLE DOSES
+1 NEW PSSDRUG,PSSLPD2,PSSNLPD,PSSLPDX,PSSXDT,X1,X2,X,PSSDRUGN
+2 KILL ^XTMP("PSSP134")
+3 SET X1=DT
SET X2=90
DO C^%DTC
SET PSSXDT=$GET(X)
+4 SET ^XTMP("PSSP134",0)=PSSXDT_"^"_DT
+5 SET PSSDRUG=0
FOR
SET PSSDRUG=$ORDER(^PSDRUG(PSSDRUG))
if 'PSSDRUG
QUIT
Begin DoDot:1
+6 SET PSSLPDX=0
FOR
SET PSSLPDX=$ORDER(^PSDRUG(PSSDRUG,"DOS2",PSSLPDX))
if 'PSSLPDX
QUIT
Begin DoDot:2
+7 SET PSSLPD2=$PIECE($GET(^PSDRUG(PSSDRUG,"DOS2",PSSLPDX,0)),"^",1)
+8 IF PSSLPD2=""
QUIT
+9 SET PSSNLPD=$$DOSE(PSSLPD2)
+10 SET PSSDRUGN=$PIECE($GET(^PSDRUG(PSSDRUG,0)),"^")
+11 SET ^XTMP("PSSP134",PSSDRUGN,PSSDRUG,PSSLPDX)=PSSLPD2_"^"_PSSNLPD
End DoDot:2
End DoDot:1
+12 DO REPORT
+13 QUIT
+14 ;
DOSE(PSSDOSE) ;
+1 NEW PSSCHAR,PSSXX,PSSDOSR
+2 SET (PSSXX,PSSDOSR)=""
+3 FOR PSSXX=1:1:$LENGTH(PSSDOSE)
Begin DoDot:1
+4 SET PSSCHAR=$EXTRACT(PSSDOSE,PSSXX)
+5 IF PSSCHAR="."
IF $EXTRACT(PSSDOSE,PSSXX+1)
IF $EXTRACT(PSSDOSR,$LENGTH(PSSDOSR))'?1N
SET PSSCHAR=0_PSSCHAR
+6 IF PSSDOSR]""
IF $EXTRACT(PSSDOSR,$LENGTH(PSSDOSR))?1N
IF PSSCHAR'?1N
IF "() -./%,"'[PSSCHAR
SET PSSDOSR=PSSDOSR_" "_PSSCHAR
QUIT
+7 IF PSSDOSR]""
IF $EXTRACT(PSSDOSR,$LENGTH(PSSDOSR))'?1N
IF "() -./%,"'[$EXTRACT(PSSDOSR,$LENGTH(PSSDOSR))
IF PSSCHAR?1N
SET PSSDOSR=PSSDOSR_" "_PSSCHAR
QUIT
+8 IF PSSDOSR]""
IF $EXTRACT(PSSDOSR,$LENGTH(PSSDOSR))?1N
IF PSSCHAR'?1N
SET PSSDOSR=PSSDOSR_PSSCHAR
QUIT
+9 IF PSSDOSR]""
IF $EXTRACT(PSSDOSR,$LENGTH(PSSDOSR))'?1N
IF PSSCHAR'?1N
SET PSSDOSR=PSSDOSR_PSSCHAR
QUIT
+10 SET PSSDOSR=PSSDOSR_PSSCHAR
+11 QUIT
End DoDot:1
+12 QUIT PSSDOSR
+13 ;
REPORT ;REPORT OF LOCAL POSSIBLE DOSES BEFORE AND AFTER
+1 NEW XMDUZ,XMSUB,XMTEXT,XMY,Y,PSSDT,PSSXDT,DIFROM,PSSI
+2 KILL ^XTMP("PSSP134R")
+3 SET X1=DT
SET X2=90
DO C^%DTC
SET PSSXDT=$GET(X)
+4 SET ^XTMP("PSSP134R",0)=PSSXDT_"^"_DT
+5 SET XMDUZ="REFORMATTED LOCAL POSSIBLE DOSES"
SET XMSUB="REFORMATTED LOCAL POSSIBLE DOSES"
SET XMTEXT="^XTMP(""PSSP134R"","
+6 IF $DATA(^XUSEC("PSNMGR"))
FOR PSSI=0:0
SET PSSI=$ORDER(^XUSEC("PSNMGR",PSSI))
if 'PSSI
QUIT
SET XMY(PSSI)=""
+7 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET PSSDT=Y
+8 SET ^XTMP("PSSP134R",1)="REFORMATTED LOCAL POSSIBLE DOSES USING API ASSOCIATED WITH PSS*1.0*78"
+9 SET ^XTMP("PSSP134R",2)=PSSDT
+10 SET ^XTMP("PSSP134R",3)=""
+11 NEW PSSLPD,PSSNLPD,PSSDRUG,PSSLPDX,PSSLPDD,PSSLINE,PSSXX,PSSDRUGN,PSSSPC,PSSX
+12 ;
+13 SET PSSXX=4
SET PSSLINE=""
SET PSSSPC=""
+14 FOR PSSX=1:1:50
SET $EXTRACT(PSSLINE,PSSXX)="-"
SET $EXTRACT(PSSSPC,PSSXX)=" "
+15 SET PSSDRUGN=""
FOR
SET PSSDRUGN=$ORDER(^XTMP("PSSP134",PSSDRUGN))
if PSSDRUGN=""
QUIT
Begin DoDot:1
+16 SET PSSDRUG=0
FOR
SET PSSDRUG=$ORDER(^XTMP("PSSP134",PSSDRUGN,PSSDRUG))
if 'PSSDRUG
QUIT
Begin DoDot:2
+17 SET ^XTMP("PSSP134R",PSSXX)=$PIECE($GET(^PSDRUG(PSSDRUG,0)),"^",1)_" (#"_PSSDRUG_")"
+18 SET PSSXX=PSSXX+1
+19 SET PSSLPDX=0
FOR
SET PSSLPDX=$ORDER(^XTMP("PSSP134",PSSDRUGN,PSSDRUG,PSSLPDX))
if 'PSSLPDX
QUIT
Begin DoDot:3
+20 SET PSSLPDD=^XTMP("PSSP134",PSSDRUGN,PSSDRUG,PSSLPDX)
+21 SET PSSLPD=$PIECE(PSSLPDD,"^")
SET PSSNLPD=$PIECE(PSSLPDD,"^",2)
+22 SET ^XTMP("PSSP134R",PSSXX)=$EXTRACT(PSSSPC,1,10)_PSSLPD
+23 SET ^XTMP("PSSP134R",PSSXX+1)=$EXTRACT(PSSSPC,1,10)_PSSNLPD
+24 SET ^XTMP("PSSP134R",PSSXX+2)=""
+25 SET PSSXX=PSSXX+3
End DoDot:3
End DoDot:2
End DoDot:1
+26 DO ^XMD
+27 QUIT
