- 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 Feb 18, 2025@23:56:37 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
