- 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
- 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
