PSSCREAT ;BIR/RTR/WRT-Auto create Pharmacy Orderable Item File; 09/01/98 7:07
;;1.0;PHARMACY DATA MANAGEMENT;**8,15**;9/30/97
CHECK ; make sure file has not already been created"
S PSSITE=+$O(^PS(59.7,0)) I $P($G(^PS(59.7,+PSSITE,80)),"^",2) W !!?3,"Orderable Item Auto-Create has ",$S($P(^(80),"^",2)=1:"already been queued,",1:"already been completed,")," no action taken!",! K PSSITE D Q
.K DIR S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR K DIR
S $P(^PS(59.7,PSSITE,80),"^",2)=1
PRI K DIR W !!,"This job will create your Pharmacy Orderable Item File, and match IV Solutions,",!,"IV Additives, and Dispense Drugs to the Pharmacy Orderable Item File."
S DIR("A",1)="Enter P to create your Pharmacy Orderable Item File first by Primary Drug",DIR("A",2)="Name, then by VA Generic Name",DIR("A",3)="Enter V to create the Pharmacy Orderable Item File by VA Generic Name only"
S DIR("A",4)="",DIR("A")="Enter P or V"
S DIR(0)="S^P:PRIMARY/VA GENERIC;V:VA GENERIC" D ^DIR K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) S $P(^PS(59.7,PSSITE,80),"^",2)="" G ENDTWO
S PSOHOW=Y
W !,"This job should be queued to run at night!",!
D NOW^%DTC K %DT S %DT="FRAEX",%DT(0)=%,%DT("A")="QUEUE TO RUN AT WHAT TIME: " D ^%DT S PSOQTIME=Y I $D(DTOUT)!(Y=-1) W !!,"Try again later!",! S $P(^PS(59.7,PSSITE,80),"^",2)="" G ENDTWO
S PSOMDUZ=DUZ,ZTIO="",ZTRTN="BEG^PSSCREAT",ZTDTH=PSOQTIME,ZTDESC="AUTO CREATE ORDERABLE ITEM FILE",ZTSAVE("PSCREATE")="",ZTSAVE("PSOHOW")="",ZTSAVE("PSOMDUZ")="",ZTSAVE("PSSITE")="" D ^%ZTLOAD W !!,"TASK QUEUED!",! G ENDTWO
BEG ;
S PSCREATE=1
I PSOHOW="P" D ^PSSSPD G START
D IVADD^PSSSPD
START K ^TMP("PSSD",$J),^TMP("PSS",$J),^TMP("PSSADD",$J),^TMP("PSSOL",$J)
F RRR=0:0 S RRR=$O(^PSDRUG(RRR)) Q:'RRR S (FLAGONE,FLAGTWO)=0 D D:$G(FLAGONE) MATCH D:$G(FLAGTWO) ADD
.S NODE=$G(^PSDRUG(RRR,"ND")),SUPER=$P($G(^PSDRUG(RRR,2)),"^"),DA=$P($G(NODE),"^"),K=$P($G(NODE),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DF1=X,DA=$P($G(NODE),"^"),X=$$VAGN^PSNAPIS(DA),GEN=X
.I +SUPER Q
.K ^TMP($J,"PSSIP") I +$P(NODE,"^"),+$P(NODE,"^",3) F VV=0:0 S VV=$O(^PSDRUG("AND",+NODE,VV)) Q:'VV I +$P($G(^PSDRUG(VV,2)),"^"),$D(^PS(50.7,$P(^PSDRUG(VV,2),"^"),0)) D
..S OTH=$G(^PSDRUG(VV,"ND")) I +$P(OTH,"^"),+$P(OTH,"^",3),$G(DF1) S DA=$P($G(OTH),"^"),K=$P($G(OTH),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DF2=X I $G(DF2) D
...I $G(DF1)=$G(DF2) S ^TMP($J,"PSSIP",VV)=$P(^PSDRUG(VV,2),"^")
.S (COMM,COMMON)=0 I $O(^TMP($J,"PSSIP",0)) S COMM=1 S CC=$O(^TMP($J,"PSSIP",0)),SPRIM=^TMP($J,"PSSIP",CC) F WW=0:0 S WW=$O(^TMP($J,"PSSIP",WW)) Q:'WW I SPRIM'=^TMP($J,"PSSIP",WW) S COMMON=1
.I COMM,COMMON Q
.I COMM,'COMMON S FLAGONE=1 Q
.I +$P(NODE,"^"),+$P(NODE,"^",3),$G(GEN)'=0,$G(DF1) D
..I $L(GEN)<41 S SPNAME=GEN,SPNTR=$P(DF1,"^"),FLAGTWO=1 Q
END D ENDONE D DATE^PSSPOIM1 K RRR,STOP,^TMP($J,"PSSIP") D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
;
MATCH ;Match to an already existing Orderable Item
S DA=RRR,DIE="^PSDRUG(",DR="2.1////"_SPRIM D ^DIE D ENDONE Q
ADD ;Create a new Orderable Item entry
S STOP=0 F CHECK=0:0 S CHECK=$O(^PS(50.7,"ADF",SPNAME,SPNTR,CHECK)) Q:'CHECK!(STOP) I CHECK,$P($G(^PS(50.7,CHECK,0)),"^",3)="" S STOP=1,DIE="^PSDRUG(",DA=RRR,DR="2.1////"_CHECK D ^DIE D ENDONE Q
I STOP K STOP Q
K DD,DO S X=SPNAME,DIC="^PS(50.7,",DIC(0)="L",DIC("DR")=".02////"_SPNTR D FILE^DICN I 'Y D ENDONE Q
S SPIEN=+Y S DIE="^PSDRUG(",DA=RRR,DR="2.1////"_SPIEN D ^DIE
ENDONE K APP,CC,CHECK,COMM,COMMON,DA,DR,DIE,DIC,FLAGONE,FLAGTWO,NODE,OTH,PSDOS,PSOQTIME,SPIEN,SPNAME,SPNTR,SPRIM,SUPER,VV,WW Q
;
MAIL ;
S PSSADATE=DT F TTTT=0:0 S TTTT=$O(^PS(50.7,TTTT)) Q:'TTTT D
.I '$P($G(^PS(50.7,TTTT,0)),"^",3) D
..S (PSSLTST,PSSIFLAG)=0 F JJJJ=0:0 S JJJJ=$O(^PSDRUG("ASP",TTTT,JJJJ)) Q:'JJJJ S PSSIOU=$P($G(^PSDRUG(JJJJ,2)),"^",3) I PSSIOU["I"!(PSSIOU["O")!(PSSIOU["U") S PSSVARP=+$P($G(^PSDRUG(JJJJ,"I")),"^") D
...S:PSSVARP&(PSSVARP>PSSLTST) PSSLTST=PSSVARP I 'PSSVARP S PSSIFLAG=1
.I '$P($G(^PS(50.7,TTTT,0)),"^",3),'$P($G(^(0)),"^",4),'PSSIFLAG K DIE S DIE="^PS(50.7,",DA=TTTT,DR=".04////"_$S('PSSLTST:PSSADATE,1:PSSLTST) D ^DIE K DIE
.I $P($G(^PS(50.7,TTTT,0)),"^",3) D
..S (PSSLTST,PSSIFLAG)=0 F JJJJ=0:0 S JJJJ=$O(^PS(52.6,"AOI",TTTT,JJJJ)) Q:'JJJJ I $D(^PS(52.6,JJJJ,0)) S PSSVARP=+$P($G(^("I")),"^") D
...S:PSSVARP&(PSSVARP>PSSLTST) PSSLTST=PSSVARP I 'PSSVARP S PSSIFLAG=1
..F JJJJ=0:0 S JJJJ=$O(^PS(52.7,"AOI",TTTT,JJJJ)) Q:'JJJJ I $D(^PS(52.7,JJJJ,0)) S PSSVARP=+$P($G(^("I")),"^") D
...S:PSSVARP&(PSSVARP>PSSLTST) PSSLTST=PSSVARP I 'PSSVARP S PSSIFLAG=1
.I $P($G(^PS(50.7,TTTT,0)),"^",3),'$P($G(^(0)),"^",4),'PSSIFLAG K DIE S DIE="^PS(50.7,",DA=TTTT,DR=".04////"_$S('PSSLTST:PSSADATE,1:PSSLTST) D ^DIE K DIE
K PSSVARP,PSSIOU,PSSADATE,TTTT,JJJJ,PSSIFLAG,PSSLTST D ^PSSSYN K NUM,NUMB,POI,SYNO
;
S XMDUZ="PHARMACY DATA MANAGEMENT PACKAGE",XMY(.5)="",XMY(PSOMDUZ)="",XMSUB="Pharmacy Orderable Item Auto-Create"
S PSSATEXT(1)="The Pharmacy Orderable Item Auto-create has successfully run to",PSSATEXT(2)="Completion! You may now begin the manual matching process."
S XMTEXT="PSSATEXT(" D ^XMD S:'$G(PSSITE) PSSITE=+$O(^PS(59.7,0)) S $P(^PS(59.7,PSSITE,80),"^",2)=2 Q
ENDTWO D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K PSOMDUZ,PSSITE Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSCREAT 5194 printed Dec 13, 2024@02:30:35 Page 2
PSSCREAT ;BIR/RTR/WRT-Auto create Pharmacy Orderable Item File; 09/01/98 7:07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**8,15**;9/30/97
CHECK ; make sure file has not already been created"
+1 SET PSSITE=+$ORDER(^PS(59.7,0))
IF $PIECE($GET(^PS(59.7,+PSSITE,80)),"^",2)
WRITE !!?3,"Orderable Item Auto-Create has ",$SELECT($PIECE(^(80),"^",2)=1:"already been queued,",1:"already been completed,")," no action taken!",!
KILL PSSITE
Begin DoDot:1
+2 KILL DIR
SET DIR("A")="Press RETURN to continue"
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+3 SET $PIECE(^PS(59.7,PSSITE,80),"^",2)=1
PRI KILL DIR
WRITE !!,"This job will create your Pharmacy Orderable Item File, and match IV Solutions,",!,"IV Additives, and Dispense Drugs to the Pharmacy Orderable Item File."
+1 SET DIR("A",1)="Enter P to create your Pharmacy Orderable Item File first by Primary Drug"
SET DIR("A",2)="Name, then by VA Generic Name"
SET DIR("A",3)="Enter V to create the Pharmacy Orderable Item File by VA Generic Name only"
+2 SET DIR("A",4)=""
SET DIR("A")="Enter P or V"
+3 SET DIR(0)="S^P:PRIMARY/VA GENERIC;V:VA GENERIC"
DO ^DIR
KILL DIR
IF Y["^"!($DATA(DTOUT))!($DATA(DUOUT))
SET $PIECE(^PS(59.7,PSSITE,80),"^",2)=""
GOTO ENDTWO
+4 SET PSOHOW=Y
+5 WRITE !,"This job should be queued to run at night!",!
+6 DO NOW^%DTC
KILL %DT
SET %DT="FRAEX"
SET %DT(0)=%
SET %DT("A")="QUEUE TO RUN AT WHAT TIME: "
DO ^%DT
SET PSOQTIME=Y
IF $DATA(DTOUT)!(Y=-1)
WRITE !!,"Try again later!",!
SET $PIECE(^PS(59.7,PSSITE,80),"^",2)=""
GOTO ENDTWO
+7 SET PSOMDUZ=DUZ
SET ZTIO=""
SET ZTRTN="BEG^PSSCREAT"
SET ZTDTH=PSOQTIME
SET ZTDESC="AUTO CREATE ORDERABLE ITEM FILE"
SET ZTSAVE("PSCREATE")=""
SET ZTSAVE("PSOHOW")=""
SET ZTSAVE("PSOMDUZ")=""
SET ZTSAVE("PSSITE")=""
DO ^%ZTLOAD
WRITE !!,"TASK QUEUED!",!
GOTO ENDTWO
BEG ;
+1 SET PSCREATE=1
+2 IF PSOHOW="P"
DO ^PSSSPD
GOTO START
+3 DO IVADD^PSSSPD
START KILL ^TMP("PSSD",$JOB),^TMP("PSS",$JOB),^TMP("PSSADD",$JOB),^TMP("PSSOL",$JOB)
+1 FOR RRR=0:0
SET RRR=$ORDER(^PSDRUG(RRR))
if 'RRR
QUIT
SET (FLAGONE,FLAGTWO)=0
Begin DoDot:1
+2 SET NODE=$GET(^PSDRUG(RRR,"ND"))
SET SUPER=$PIECE($GET(^PSDRUG(RRR,2)),"^")
SET DA=$PIECE($GET(NODE),"^")
SET K=$PIECE($GET(NODE),"^",3)
SET X=$$PSJDF^PSNAPIS(DA,K)
SET DF1=X
SET DA=$PIECE($GET(NODE),"^")
SET X=$$VAGN^PSNAPIS(DA)
SET GEN=X
+3 IF +SUPER
QUIT
+4 KILL ^TMP($JOB,"PSSIP")
IF +$PIECE(NODE,"^")
IF +$PIECE(NODE,"^",3)
FOR VV=0:0
SET VV=$ORDER(^PSDRUG("AND",+NODE,VV))
if 'VV
QUIT
IF +$PIECE($GET(^PSDRUG(VV,2)),"^")
IF $DATA(^PS(50.7,$PIECE(^PSDRUG(VV,2),"^"),0))
Begin DoDot:2
+5 SET OTH=$GET(^PSDRUG(VV,"ND"))
IF +$PIECE(OTH,"^")
IF +$PIECE(OTH,"^",3)
IF $GET(DF1)
SET DA=$PIECE($GET(OTH),"^")
SET K=$PIECE($GET(OTH),"^",3)
SET X=$$PSJDF^PSNAPIS(DA,K)
SET DF2=X
IF $GET(DF2)
Begin DoDot:3
+6 IF $GET(DF1)=$GET(DF2)
SET ^TMP($JOB,"PSSIP",VV)=$PIECE(^PSDRUG(VV,2),"^")
End DoDot:3
End DoDot:2
+7 SET (COMM,COMMON)=0
IF $ORDER(^TMP($JOB,"PSSIP",0))
SET COMM=1
SET CC=$ORDER(^TMP($JOB,"PSSIP",0))
SET SPRIM=^TMP($JOB,"PSSIP",CC)
FOR WW=0:0
SET WW=$ORDER(^TMP($JOB,"PSSIP",WW))
if 'WW
QUIT
IF SPRIM'=^TMP($JOB,"PSSIP",WW)
SET COMMON=1
+8 IF COMM
IF COMMON
QUIT
+9 IF COMM
IF 'COMMON
SET FLAGONE=1
QUIT
+10 IF +$PIECE(NODE,"^")
IF +$PIECE(NODE,"^",3)
IF $GET(GEN)'=0
IF $GET(DF1)
Begin DoDot:2
+11 IF $LENGTH(GEN)<41
SET SPNAME=GEN
SET SPNTR=$PIECE(DF1,"^")
SET FLAGTWO=1
QUIT
End DoDot:2
End DoDot:1
if $GET(FLAGONE)
DO MATCH
if $GET(FLAGTWO)
DO ADD
END DO ENDONE
DO DATE^PSSPOIM1
KILL RRR,STOP,^TMP($JOB,"PSSIP")
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+1 ;
MATCH ;Match to an already existing Orderable Item
+1 SET DA=RRR
SET DIE="^PSDRUG("
SET DR="2.1////"_SPRIM
DO ^DIE
DO ENDONE
QUIT
ADD ;Create a new Orderable Item entry
+1 SET STOP=0
FOR CHECK=0:0
SET CHECK=$ORDER(^PS(50.7,"ADF",SPNAME,SPNTR,CHECK))
if 'CHECK!(STOP)
QUIT
IF CHECK
IF $PIECE($GET(^PS(50.7,CHECK,0)),"^",3)=""
SET STOP=1
SET DIE="^PSDRUG("
SET DA=RRR
SET DR="2.1////"_CHECK
DO ^DIE
DO ENDONE
QUIT
+2 IF STOP
KILL STOP
QUIT
+3 KILL DD,DO
SET X=SPNAME
SET DIC="^PS(50.7,"
SET DIC(0)="L"
SET DIC("DR")=".02////"_SPNTR
DO FILE^DICN
IF 'Y
DO ENDONE
QUIT
+4 SET SPIEN=+Y
SET DIE="^PSDRUG("
SET DA=RRR
SET DR="2.1////"_SPIEN
DO ^DIE
ENDONE KILL APP,CC,CHECK,COMM,COMMON,DA,DR,DIE,DIC,FLAGONE,FLAGTWO,NODE,OTH,PSDOS,PSOQTIME,SPIEN,SPNAME,SPNTR,SPRIM,SUPER,VV,WW
QUIT
+1 ;
MAIL ;
+1 SET PSSADATE=DT
FOR TTTT=0:0
SET TTTT=$ORDER(^PS(50.7,TTTT))
if 'TTTT
QUIT
Begin DoDot:1
+2 IF '$PIECE($GET(^PS(50.7,TTTT,0)),"^",3)
Begin DoDot:2
+3 SET (PSSLTST,PSSIFLAG)=0
FOR JJJJ=0:0
SET JJJJ=$ORDER(^PSDRUG("ASP",TTTT,JJJJ))
if 'JJJJ
QUIT
SET PSSIOU=$PIECE($GET(^PSDRUG(JJJJ,2)),"^",3)
IF PSSIOU["I"!(PSSIOU["O")!(PSSIOU["U")
SET PSSVARP=+$PIECE($GET(^PSDRUG(JJJJ,"I")),"^")
Begin DoDot:3
+4 if PSSVARP&(PSSVARP>PSSLTST)
SET PSSLTST=PSSVARP
IF 'PSSVARP
SET PSSIFLAG=1
End DoDot:3
End DoDot:2
+5 IF '$PIECE($GET(^PS(50.7,TTTT,0)),"^",3)
IF '$PIECE($GET(^(0)),"^",4)
IF 'PSSIFLAG
KILL DIE
SET DIE="^PS(50.7,"
SET DA=TTTT
SET DR=".04////"_$SELECT('PSSLTST:PSSADATE,1:PSSLTST)
DO ^DIE
KILL DIE
+6 IF $PIECE($GET(^PS(50.7,TTTT,0)),"^",3)
Begin DoDot:2
+7 SET (PSSLTST,PSSIFLAG)=0
FOR JJJJ=0:0
SET JJJJ=$ORDER(^PS(52.6,"AOI",TTTT,JJJJ))
if 'JJJJ
QUIT
IF $DATA(^PS(52.6,JJJJ,0))
SET PSSVARP=+$PIECE($GET(^("I")),"^")
Begin DoDot:3
+8 if PSSVARP&(PSSVARP>PSSLTST)
SET PSSLTST=PSSVARP
IF 'PSSVARP
SET PSSIFLAG=1
End DoDot:3
+9 FOR JJJJ=0:0
SET JJJJ=$ORDER(^PS(52.7,"AOI",TTTT,JJJJ))
if 'JJJJ
QUIT
IF $DATA(^PS(52.7,JJJJ,0))
SET PSSVARP=+$PIECE($GET(^("I")),"^")
Begin DoDot:3
+10 if PSSVARP&(PSSVARP>PSSLTST)
SET PSSLTST=PSSVARP
IF 'PSSVARP
SET PSSIFLAG=1
End DoDot:3
End DoDot:2
+11 IF $PIECE($GET(^PS(50.7,TTTT,0)),"^",3)
IF '$PIECE($GET(^(0)),"^",4)
IF 'PSSIFLAG
KILL DIE
SET DIE="^PS(50.7,"
SET DA=TTTT
SET DR=".04////"_$SELECT('PSSLTST:PSSADATE,1:PSSLTST)
DO ^DIE
KILL DIE
End DoDot:1
+12 KILL PSSVARP,PSSIOU,PSSADATE,TTTT,JJJJ,PSSIFLAG,PSSLTST
DO ^PSSSYN
KILL NUM,NUMB,POI,SYNO
+13 ;
+14 SET XMDUZ="PHARMACY DATA MANAGEMENT PACKAGE"
SET XMY(.5)=""
SET XMY(PSOMDUZ)=""
SET XMSUB="Pharmacy Orderable Item Auto-Create"
+15 SET PSSATEXT(1)="The Pharmacy Orderable Item Auto-create has successfully run to"
SET PSSATEXT(2)="Completion! You may now begin the manual matching process."
+16 SET XMTEXT="PSSATEXT("
DO ^XMD
if '$GET(PSSITE)
SET PSSITE=+$ORDER(^PS(59.7,0))
SET $PIECE(^PS(59.7,PSSITE,80),"^",2)=2
QUIT
ENDTWO DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL PSOMDUZ,PSSITE
QUIT
