- PSOAMIS0 ;BHAM ISC/SAB,BHW - pharmacy amis compile/recompile routine ;2/9/06 4:13pm
- ;;7.0;OUTPATIENT PHARMACY;**17,25,158,232**;DEC 1997
- ;
- ; reference to ^VA(200 supported by IA# 224
- ; reference to ^PSDRUG supported by IA# 221
- ;
- ;PSO*232 alter For loops to include release/dates without time stamp
- ;
- K ^TMP("PSOAMIS",$J) S X="T-1",%DT="" D ^%DT S (PSDATE,HDATE)=Y,ENDATE=Y_".9999999" S DA=PSDATE,DIK="^PS(59.1," D ^DIK D CLE,ADD
- S PSDATE=PSDATE-1+.999999 ;PSO*232
- F RR=0:0 S PSDATE=$O(^PSRX("AL",PSDATE)) Q:'PSDATE!(PSDATE>ENDATE) D COM
- S PSDATE=HDATE-1+.999999 ;PSO*232
- F RR=0:0 S PSDATE=$O(^PSRX("AM",PSDATE)) Q:'PSDATE!(PSDATE>ENDATE) D COM1
- S PSDATE=HDATE D BUILD
- END K ^TMP("PSOAMIS",$J),DIC,I,ENT,Y,X,DINUM,%DT,PSDATE,METHAD,DA,PSODFN,DRUG,NRC,PAT,PHYS,DIV,RX,ST,STY,STY1,SDT,EDT,R,RXF,TY,ENDATE,HDATE S:$D(ZTQUEUED) ZTREQ="@"
- K RX0,RX2,DIK,C,BLD,LSTDFN,LSTDT
- Q
- COM F PSODFN=0:0 S PSODFN=$O(^PSRX("AL",PSDATE,PSODFN)) Q:'PSODFN S DA="" F TY=0:0 S DA=$O(^PSRX("AL",PSDATE,PSODFN,DA)) Q:DA="" I $D(^PSRX(PSODFN,0)) D
- .S RX0=^PSRX(PSODFN,0),RX2=^(2),PAT=$P(RX0,"^",2),ST=$P(RX0,"^",3),DRUG=$P(RX0,"^",6)
- .D:'DA ORI D:DA REF
- Q
- COM1 F PSODFN=0:0 S PSODFN=$O(^PSRX("AM",PSDATE,PSODFN)) Q:'PSODFN S DA=0 F S DA=$O(^PSRX("AM",PSDATE,PSODFN,DA)) Q:'DA I $D(^PSRX(PSODFN,0)) D:$P($G(^PSRX(PSODFN,"P",DA,0)),"^",19)
- .S RX0=^PSRX(PSODFN,0),RX2=^PSRX(PSODFN,2),PAT=$P(RX0,"^",2),ST=$P(RX0,"^",3),DRUG=$P(RX0,"^",6)
- .S RXF=^PSRX(PSODFN,"P",DA,0),DIV=$S($P(RXF,"^",9):$P(RXF,"^",9),1:$P(RX2,"^",9)),$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",14)=+$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",14)+1
- .S $P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",$S($P(RXF,"^",2)="W":15,1:16))=+$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",$S($P(RXF,"^",2)="W":15,1:16))+1
- .S PHYS=$S($P(RXF,"^",17):+$P(RXF,"^",17),1:$P(RX0,"^",4))
- .I $P($G(^VA(200,PHYS,"PS")),"^",6)=4 S $P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",10)=+$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",10)+1
- .E S $P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",11)=+$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",11)+1
- .D STA
- Q
- ORI Q:'$P(RX2,"^",13)!('$D(^PS(59,+$P(RX2,"^",9),0)))
- S RX=^PSRX(PSODFN,0),PHYS=+$P(RX,"^",4),DIV=$S($P(RX2,"^",9):$P(RX2,"^",9),1:$O(^PS(59,0))),$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",13)=+$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",13)+1
- S $P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",$S($P(RX,"^",11)="W":15,1:16))=+$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",$S($P(RX,"^",11)="W":15,1:16))+1
- I $P($G(^VA(200,PHYS,"PS")),"^",6)=4 S $P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",10)=+$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",10)+1
- E S $P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",11)=+$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",11)+1
- D STA
- Q
- REF Q:'$P($G(^PSRX(PSODFN,1,DA,0)),"^",18)!('$D(^PS(59,$P($G(^PSRX(PSODFN,1,DA,0)),"^",9),0)))
- S RXF=^PSRX(PSODFN,1,DA,0),DIV=$S($P(RXF,"^",9):$P(RXF,"^",9),1:DIV),$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",14)=+$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",14)+1
- S $P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",$S($P(RXF,"^",2)="W":15,1:16))=+$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",$S($P(RXF,"^",2)="W":15,1:16))+1
- S PHYS=$S($P(RXF,"^",17):+$P(RXF,"^",17),1:$P(RX0,"^",4))
- I $P($G(^VA(200,PHYS,"PS")),"^",6)=4 S $P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",10)=+$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",10)+1
- E S $P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",11)=+$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",11)+1
- D STA
- Q
- CLE F I=0:0 S I=$O(^PS(59,I)) Q:'I S METHAD(I)=+$P($G(^PS(59,I,5)),"^",2),^TMP("PSOAMIS",$J,"AMIS",I)=0
- Q
- STA S STY=$P($G(^PS(53,ST,0)),"^",6)
- S $P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",$S(STY=1:2,STY=2:4,STY=3:6,STY=4:1,STY=5:17,1:12))=+$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",$S(STY=1:2,STY=2:4,STY=3:6,STY=4:1,STY=5:17,1:12))+1
- S NRC=$P($G(^PSDRUG(DRUG,0)),"^",3) I NRC["A"!(NRC["C") S $P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",7)=$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",7)+1
- S:DRUG=$G(METHAD(DIV)) $P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",8)=$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",8)+1
- I '$D(^TMP("PSOAMIS",$J,DIV,PAT)) S ^TMP("PSOAMIS",$J,DIV,PAT)="",$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",9)=$P(^TMP("PSOAMIS",$J,"AMIS",DIV),"^",9)+1
- Q
- BUILD ;set global node
- F I=0:0 S I=$O(^PS(59,I)) Q:'I S ^PS(59.1,$P(PSDATE,"."),1,I,0)=$P(^PS(59.1,$P(PSDATE,"."),1,I,0),"^")_"^"_^TMP("PSOAMIS",$J,"AMIS",I) D
- .F IFN=2:1:18 S $P(^PS(59.1,$P(PSDATE,"."),1,I,0),"^",IFN)=+$P(^PS(59.1,$P(PSDATE,"."),1,I,0),"^",IFN)
- K PAT,IFN,^TMP("PSOAMIS",$J)
- Q
- ADD Q:$G(^PS(59.1,$P(PSDATE,"."),0))
- S (X,DINUM)=$P(PSDATE,"."),DIC="^PS(59.1,",DIC(0)="L" K DD,DO D FILE^DICN K DD,DO
- S I=0 F S I=$O(^PS(59,I)) Q:'I S ^PS(59.1,$P(PSDATE,"."),1,0)="^59.11PA^"_I,^PS(59.1,$P(PSDATE,"."),1,I,0)=I,^PS(59.1,$P(PSDATE,"."),1,"B",I,I)="" S $P(^PS(59.1,$P(PSDATE,"."),1,0),"^",4)=($P(^PS(59.1,$P(PSDATE,"."),1,0),"^",4)+1)
- Q
- RECOM ;recompiles AMIS data
- K ^TMP("PSOAMIS",$J)
- W ! S %DT(0)=-DT,%DT("A")="Recompile AMIS Starting: " S %DT="EPXA" D ^%DT G:"^"[X END G RECOM:'Y S (HDATE,SDT)=Y K %DT(0)
- REDT W ! S %DT(0)=SDT,%DT("A")="Ending Stats Date: " D ^%DT G:"^"[X END S EDT=Y I Y<0 G REDT
- S EDT=EDT_".9999999"
- S ZTRTN="BEG^PSOAMIS0",ZTDESC="Recompile Outpatient AMIS Data",ZTIO="" F G="SDT","EDT","HDATE" S:$D(@G) ZTSAVE(G)=""
- D ^%ZTLOAD W:$D(ZTSK) !!,"Task Queued !",! K SDT,EDT,G,ZTSK,ZTIO
- Q
- BEG K LSTDFN,LSTDT,^TMP("PSOAMIS",$J) S LSTDT="",PSDATE=SDT,BLD=0
- S PSDT=SDT-1 F S PSDT=$O(^PS(59.1,PSDT)) Q:'PSDT!(PSDT>EDT) K ^PS(59.1,PSDT),^PS(59.1,"B",PSDT,PSDT)
- F I=0:0 S I=$O(^PS(59,I)) Q:'I S METHAD(I)=+$P($G(^PS(59,I,5)),"^",2)
- S PSDATE=PSDATE-1+.999999 ;PSO*232
- F R=0:0 S PSDATE=$O(^PSRX("AL",PSDATE)) Q:'PSDATE!(PSDATE>EDT) F RXN=0:0 S RXN=$O(^PSRX("AL",PSDATE,RXN)) Q:'RXN S DA="" F TY=0:0 S DA=$O(^PSRX("AL",PSDATE,RXN,DA)) Q:DA="" I $D(^PSRX(RXN,0)) D
- .S RX0=^PSRX(RXN,0),RX2=^(2),PAT=$P(RX0,"^",2),ST=$P(RX0,"^",3),DRUG=$P(RX0,"^",6)
- .D:'DA ORI1 D:DA REF1
- S PSDATE=HDATE-1+.999999 ;PSO*232
- F R=0:0 S PSDATE=$O(^PSRX("AM",PSDATE)) Q:'PSDATE!(PSDATE>EDT) F RXN=0:0 S RXN=$O(^PSRX("AM",PSDATE,RXN)) Q:'RXN S DA=0 F S DA=$O(^PSRX("AM",PSDATE,RXN,DA)) Q:'DA I $D(^PSRX(RXN,0)) D:$P($G(^PSRX(RXN,"P",DA,0)),"^",19)
- .S RX0=^PSRX(RXN,0),RX2=^(2),PAT=$P(RX0,"^",2),ST=$P(RX0,"^",3),DRUG=$P(RX0,"^",6)
- .S RXF=^PSRX(RXN,"P",DA,0),DIV=$S($P(RXF,"^",9):$P(RXF,"^",9),1:$P(RX2,"^",9))
- .D PAR
- ;
- Q
- ORI1 Q:'$P(RX2,"^",13)
- S RX=^PSRX(RXN,0),PHYS=+$P(RX,"^",4),DIV=$S($P(RX2,"^",9):$P(RX2,"^",9),1:$O(^PS(59,0)))
- D SETNODE
- S $P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",14)=$P($G(^PS(59.1,$P(PSDATE,"."),1,DIV,0)),"^",14)+1
- S $P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",$S($P(RX,"^",11)="W":16,1:17))=$P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",$S($P(RX,"^",11)="W":16,1:17))+1
- D SETUP
- Q
- REF1 Q:'$P($G(^PSRX(RXN,1,DA,0)),"^",18)
- S RXF=^PSRX(RXN,1,DA,0),DIV=$S($P(RXF,"^",9):$P(RXF,"^",9),1:DIV)
- PAR D SETNODE
- S PHYS=$S($P(RXF,"^",17):+$P(RXF,"^",17),1:$P(RX0,"^",4))
- S $P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",15)=$P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",15)+1
- S $P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",$S($P(RXF,"^",2)="W":16,1:17))=$P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",$S($P(RXF,"^",2)="W":16,1:17))+1
- D SETUP
- Q
- SETUP ;
- I $P($G(^VA(200,PHYS,"PS")),"^",6)=4 S $P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",11)=$P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",11)+1
- E S $P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",12)=$P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",12)+1
- S STY=$P($G(^PS(53,ST,0)),"^",6)
- S $P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",$S(STY=1:3,STY=2:5,STY=3:7,STY=4:2,STY=5:18,1:13))=+$P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",$S(STY=1:3,STY=2:5,STY=3:7,STY=4:2,STY=5:18,1:13))+1
- S NRC=$P($G(^PSDRUG(DRUG,0)),"^",3) I NRC["A"!(NRC["C") S $P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",8)=$P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",8)+1
- S:DRUG=$G(METHAD(DIV)) $P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",9)=$P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",9)+1
- I '$D(^TMP("PSOAMIS",$J,DIV,$P(PSDATE,"."),PAT)) S ^TMP("PSOAMIS",$J,DIV,$P(PSDATE,"."),PAT)="",$P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",10)=$P(^PS(59.1,$P(PSDATE,"."),1,DIV,0),"^",10)+1
- Q
- SETNODE ;
- I '$G(^PS(59.1,$P(PSDATE,"."),0)) D
- .S (X,DINUM)=$P(PSDATE,"."),DIC="^PS(59.1,",DIC(0)="L" K DD,DO D FILE^DICN K DD,DO
- .S ^PS(59.1,$P(PSDATE,"."),1,0)="^59.11PA^"
- .F I=0:0 S I=$O(^PS(59,I)) Q:'I S ^PS(59.1,$P(PSDATE,"."),1,I,0)=I_"^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0",^PS(59.1,$P(PSDATE,"."),1,"B",I,I)="" D
- ..S $P(^PS(59.1,$P(PSDATE,"."),1,0),"^",3)=I,$P(^PS(59.1,$P(PSDATE,"."),1,0),"^",4)=($P(^PS(59.1,$P(PSDATE,"."),1,0),"^",4)+1)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOAMIS0 8614 printed Apr 23, 2025@18:38:33 Page 2
- PSOAMIS0 ;BHAM ISC/SAB,BHW - pharmacy amis compile/recompile routine ;2/9/06 4:13pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**17,25,158,232**;DEC 1997
- +2 ;
- +3 ; reference to ^VA(200 supported by IA# 224
- +4 ; reference to ^PSDRUG supported by IA# 221
- +5 ;
- +6 ;PSO*232 alter For loops to include release/dates without time stamp
- +7 ;
- +8 KILL ^TMP("PSOAMIS",$JOB)
- SET X="T-1"
- SET %DT=""
- DO ^%DT
- SET (PSDATE,HDATE)=Y
- SET ENDATE=Y_".9999999"
- SET DA=PSDATE
- SET DIK="^PS(59.1,"
- DO ^DIK
- DO CLE
- DO ADD
- +9 ;PSO*232
- SET PSDATE=PSDATE-1+.999999
- +10 FOR RR=0:0
- SET PSDATE=$ORDER(^PSRX("AL",PSDATE))
- if 'PSDATE!(PSDATE>ENDATE)
- QUIT
- DO COM
- +11 ;PSO*232
- SET PSDATE=HDATE-1+.999999
- +12 FOR RR=0:0
- SET PSDATE=$ORDER(^PSRX("AM",PSDATE))
- if 'PSDATE!(PSDATE>ENDATE)
- QUIT
- DO COM1
- +13 SET PSDATE=HDATE
- DO BUILD
- END KILL ^TMP("PSOAMIS",$JOB),DIC,I,ENT,Y,X,DINUM,%DT,PSDATE,METHAD,DA,PSODFN,DRUG,NRC,PAT,PHYS,DIV,RX,ST,STY,STY1,SDT,EDT,R,RXF,TY,ENDATE,HDATE
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +1 KILL RX0,RX2,DIK,C,BLD,LSTDFN,LSTDT
- +2 QUIT
- COM FOR PSODFN=0:0
- SET PSODFN=$ORDER(^PSRX("AL",PSDATE,PSODFN))
- if 'PSODFN
- QUIT
- SET DA=""
- FOR TY=0:0
- SET DA=$ORDER(^PSRX("AL",PSDATE,PSODFN,DA))
- if DA=""
- QUIT
- IF $DATA(^PSRX(PSODFN,0))
- Begin DoDot:1
- +1 SET RX0=^PSRX(PSODFN,0)
- SET RX2=^(2)
- SET PAT=$PIECE(RX0,"^",2)
- SET ST=$PIECE(RX0,"^",3)
- SET DRUG=$PIECE(RX0,"^",6)
- +2 if 'DA
- DO ORI
- if DA
- DO REF
- End DoDot:1
- +3 QUIT
- COM1 FOR PSODFN=0:0
- SET PSODFN=$ORDER(^PSRX("AM",PSDATE,PSODFN))
- if 'PSODFN
- QUIT
- SET DA=0
- FOR
- SET DA=$ORDER(^PSRX("AM",PSDATE,PSODFN,DA))
- if 'DA
- QUIT
- IF $DATA(^PSRX(PSODFN,0))
- if $PIECE($GET(^PSRX(PSODFN,"P",DA,0)),"^",19)
- Begin DoDot:1
- +1 SET RX0=^PSRX(PSODFN,0)
- SET RX2=^PSRX(PSODFN,2)
- SET PAT=$PIECE(RX0,"^",2)
- SET ST=$PIECE(RX0,"^",3)
- SET DRUG=$PIECE(RX0,"^",6)
- +2 SET RXF=^PSRX(PSODFN,"P",DA,0)
- SET DIV=$SELECT($PIECE(RXF,"^",9):$PIECE(RXF,"^",9),1:$PIECE(RX2,"^",9))
- SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",14)=+$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",14)+1
- +3 SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",$SELECT($PIECE(RXF,"^",2)="W":15,1:16))=+$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",$SELECT($PIECE(RXF,"^",2)="W":15,1:16))+1
- +4 SET PHYS=$SELECT($PIECE(RXF,"^",17):+$PIECE(RXF,"^",17),1:$PIECE(RX0,"^",4))
- +5 IF $PIECE($GET(^VA(200,PHYS,"PS")),"^",6)=4
- SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",10)=+$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",10)+1
- +6 IF '$TEST
- SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",11)=+$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",11)+1
- +7 DO STA
- End DoDot:1
- +8 QUIT
- ORI if '$PIECE(RX2,"^",13)!('$DATA(^PS(59,+$PIECE(RX2,"^",9),0)))
- QUIT
- +1 SET RX=^PSRX(PSODFN,0)
- SET PHYS=+$PIECE(RX,"^",4)
- SET DIV=$SELECT($PIECE(RX2,"^",9):$PIECE(RX2,"^",9),1:$ORDER(^PS(59,0)))
- SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",13)=+$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",13)+1
- +2 SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",$SELECT($PIECE(RX,"^",11)="W":15,1:16))=+$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",$SELECT($PIECE(RX,"^",11)="W":15,1:16))+1
- +3 IF $PIECE($GET(^VA(200,PHYS,"PS")),"^",6)=4
- SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",10)=+$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",10)+1
- +4 IF '$TEST
- SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",11)=+$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",11)+1
- +5 DO STA
- +6 QUIT
- REF if '$PIECE($GET(^PSRX(PSODFN,1,DA,0)),"^",18)!('$DATA(^PS(59,$PIECE($GET(^PSRX(PSODFN,1,DA,0)),"^",9),0)))
- QUIT
- +1 SET RXF=^PSRX(PSODFN,1,DA,0)
- SET DIV=$SELECT($PIECE(RXF,"^",9):$PIECE(RXF,"^",9),1:DIV)
- SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",14)=+$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",14)+1
- +2 SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",$SELECT($PIECE(RXF,"^",2)="W":15,1:16))=+$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",$SELECT($PIECE(RXF,"^",2)="W":15,1:16))+1
- +3 SET PHYS=$SELECT($PIECE(RXF,"^",17):+$PIECE(RXF,"^",17),1:$PIECE(RX0,"^",4))
- +4 IF $PIECE($GET(^VA(200,PHYS,"PS")),"^",6)=4
- SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",10)=+$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",10)+1
- +5 IF '$TEST
- SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",11)=+$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",11)+1
- +6 DO STA
- +7 QUIT
- CLE FOR I=0:0
- SET I=$ORDER(^PS(59,I))
- if 'I
- QUIT
- SET METHAD(I)=+$PIECE($GET(^PS(59,I,5)),"^",2)
- SET ^TMP("PSOAMIS",$JOB,"AMIS",I)=0
- +1 QUIT
- STA SET STY=$PIECE($GET(^PS(53,ST,0)),"^",6)
- +1 SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",$SELECT(STY=1:2,STY=2:4,STY=3:6,STY=4:1,STY=5:17,1:12))=+$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",$SELECT(STY=1:2,STY=2:4,STY=3:6,STY=4:1,STY=5:17,1:12))+1
- +2 SET NRC=$PIECE($GET(^PSDRUG(DRUG,0)),"^",3)
- IF NRC["A"!(NRC["C")
- SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",7)=$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",7)+1
- +3 if DRUG=$GET(METHAD(DIV))
- SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",8)=$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",8)+1
- +4 IF '$DATA(^TMP("PSOAMIS",$JOB,DIV,PAT))
- SET ^TMP("PSOAMIS",$JOB,DIV,PAT)=""
- SET $PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",9)=$PIECE(^TMP("PSOAMIS",$JOB,"AMIS",DIV),"^",9)+1
- +5 QUIT
- BUILD ;set global node
- +1 FOR I=0:0
- SET I=$ORDER(^PS(59,I))
- if 'I
- QUIT
- SET ^PS(59.1,$PIECE(PSDATE,"."),1,I,0)=$PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,I,0),"^")_"^"_^TMP("PSOAMIS",$JOB,"AMIS",I)
- Begin DoDot:1
- +2 FOR IFN=2:1:18
- SET $PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,I,0),"^",IFN)=+$PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,I,0),"^",IFN)
- End DoDot:1
- +3 KILL PAT,IFN,^TMP("PSOAMIS",$JOB)
- +4 QUIT
- ADD if $GET(^PS(59.1,$PIECE(PSDATE,"."),0))
- QUIT
- +1 SET (X,DINUM)=$PIECE(PSDATE,".")
- SET DIC="^PS(59.1,"
- SET DIC(0)="L"
- KILL DD,DO
- DO FILE^DICN
- KILL DD,DO
- +2 SET I=0
- FOR
- SET I=$ORDER(^PS(59,I))
- if 'I
- QUIT
- SET ^PS(59.1,$PIECE(PSDATE,"."),1,0)="^59.11PA^"_I
- SET ^PS(59.1,$PIECE(PSDATE,"."),1,I,0)=I
- SET ^PS(59.1,$PIECE(PSDATE,"."),1,"B",I,I)=""
- SET $PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,0),"^",4)=($PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,0),"^",4)+1)
- +3 QUIT
- RECOM ;recompiles AMIS data
- +1 KILL ^TMP("PSOAMIS",$JOB)
- +2 WRITE !
- SET %DT(0)=-DT
- SET %DT("A")="Recompile AMIS Starting: "
- SET %DT="EPXA"
- DO ^%DT
- if "^"[X
- GOTO END
- if 'Y
- GOTO RECOM
- SET (HDATE,SDT)=Y
- KILL %DT(0)
- REDT WRITE !
- SET %DT(0)=SDT
- SET %DT("A")="Ending Stats Date: "
- DO ^%DT
- if "^"[X
- GOTO END
- SET EDT=Y
- IF Y<0
- GOTO REDT
- +1 SET EDT=EDT_".9999999"
- +2 SET ZTRTN="BEG^PSOAMIS0"
- SET ZTDESC="Recompile Outpatient AMIS Data"
- SET ZTIO=""
- FOR G="SDT","EDT","HDATE"
- if $DATA(@G)
- SET ZTSAVE(G)=""
- +3 DO ^%ZTLOAD
- if $DATA(ZTSK)
- WRITE !!,"Task Queued !",!
- KILL SDT,EDT,G,ZTSK,ZTIO
- +4 QUIT
- BEG KILL LSTDFN,LSTDT,^TMP("PSOAMIS",$JOB)
- SET LSTDT=""
- SET PSDATE=SDT
- SET BLD=0
- +1 SET PSDT=SDT-1
- FOR
- SET PSDT=$ORDER(^PS(59.1,PSDT))
- if 'PSDT!(PSDT>EDT)
- QUIT
- KILL ^PS(59.1,PSDT),^PS(59.1,"B",PSDT,PSDT)
- +2 FOR I=0:0
- SET I=$ORDER(^PS(59,I))
- if 'I
- QUIT
- SET METHAD(I)=+$PIECE($GET(^PS(59,I,5)),"^",2)
- +3 ;PSO*232
- SET PSDATE=PSDATE-1+.999999
- +4 FOR R=0:0
- SET PSDATE=$ORDER(^PSRX("AL",PSDATE))
- if 'PSDATE!(PSDATE>EDT)
- QUIT
- FOR RXN=0:0
- SET RXN=$ORDER(^PSRX("AL",PSDATE,RXN))
- if 'RXN
- QUIT
- SET DA=""
- FOR TY=0:0
- SET DA=$ORDER(^PSRX("AL",PSDATE,RXN,DA))
- if DA=""
- QUIT
- IF $DATA(^PSRX(RXN,0))
- Begin DoDot:1
- +5 SET RX0=^PSRX(RXN,0)
- SET RX2=^(2)
- SET PAT=$PIECE(RX0,"^",2)
- SET ST=$PIECE(RX0,"^",3)
- SET DRUG=$PIECE(RX0,"^",6)
- +6 if 'DA
- DO ORI1
- if DA
- DO REF1
- End DoDot:1
- +7 ;PSO*232
- SET PSDATE=HDATE-1+.999999
- +8 FOR R=0:0
- SET PSDATE=$ORDER(^PSRX("AM",PSDATE))
- if 'PSDATE!(PSDATE>EDT)
- QUIT
- FOR RXN=0:0
- SET RXN=$ORDER(^PSRX("AM",PSDATE,RXN))
- if 'RXN
- QUIT
- SET DA=0
- FOR
- SET DA=$ORDER(^PSRX("AM",PSDATE,RXN,DA))
- if 'DA
- QUIT
- IF $DATA(^PSRX(RXN,0))
- if $PIECE($GET(^PSRX(RXN,"P",DA,0)),"^",19)
- Begin DoDot:1
- +9 SET RX0=^PSRX(RXN,0)
- SET RX2=^(2)
- SET PAT=$PIECE(RX0,"^",2)
- SET ST=$PIECE(RX0,"^",3)
- SET DRUG=$PIECE(RX0,"^",6)
- +10 SET RXF=^PSRX(RXN,"P",DA,0)
- SET DIV=$SELECT($PIECE(RXF,"^",9):$PIECE(RXF,"^",9),1:$PIECE(RX2,"^",9))
- +11 DO PAR
- End DoDot:1
- +12 ;
- +13 QUIT
- ORI1 if '$PIECE(RX2,"^",13)
- QUIT
- +1 SET RX=^PSRX(RXN,0)
- SET PHYS=+$PIECE(RX,"^",4)
- SET DIV=$SELECT($PIECE(RX2,"^",9):$PIECE(RX2,"^",9),1:$ORDER(^PS(59,0)))
- +2 DO SETNODE
- +3 SET $PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",14)=$PIECE($GET(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0)),"^",14)+1
- +4 SET $PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",$SELECT($PIECE(RX,"^",11)="W":16,1:17))=$PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",$SELECT($PIECE(RX,"^",11)="W":16,1:17))+1
- +5 DO SETUP
- +6 QUIT
- REF1 if '$PIECE($GET(^PSRX(RXN,1,DA,0)),"^",18)
- QUIT
- +1 SET RXF=^PSRX(RXN,1,DA,0)
- SET DIV=$SELECT($PIECE(RXF,"^",9):$PIECE(RXF,"^",9),1:DIV)
- PAR DO SETNODE
- +1 SET PHYS=$SELECT($PIECE(RXF,"^",17):+$PIECE(RXF,"^",17),1:$PIECE(RX0,"^",4))
- +2 SET $PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",15)=$PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",15)+1
- +3 SET $PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",$SELECT($PIECE(RXF,"^",2)="W":16,1:17))=$PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",$SELECT($PIECE(RXF,"^",2)="W":16,1:17))+1
- +4 DO SETUP
- +5 QUIT
- SETUP ;
- +1 IF $PIECE($GET(^VA(200,PHYS,"PS")),"^",6)=4
- SET $PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",11)=$PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",11)+1
- +2 IF '$TEST
- SET $PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",12)=$PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",12)+1
- +3 SET STY=$PIECE($GET(^PS(53,ST,0)),"^",6)
- +4 SET $PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",$SELECT(STY=1:3,STY=2:5,STY=3:7,STY=4:2,STY=5:18,1:13))=+$PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",$SELECT(STY=1:3,STY=2:5,STY=3:7,STY=4:2,STY=5:18,1:13))+1
- +5 SET NRC=$PIECE($GET(^PSDRUG(DRUG,0)),"^",3)
- IF NRC["A"!(NRC["C")
- SET $PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",8)=$PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",8)+1
- +6 if DRUG=$GET(METHAD(DIV))
- SET $PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",9)=$PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",9)+1
- +7 IF '$DATA(^TMP("PSOAMIS",$JOB,DIV,$PIECE(PSDATE,"."),PAT))
- SET ^TMP("PSOAMIS",$JOB,DIV,$PIECE(PSDATE,"."),PAT)=""
- SET $PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",10)=$PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,DIV,0),"^",10)+1
- +8 QUIT
- SETNODE ;
- +1 IF '$GET(^PS(59.1,$PIECE(PSDATE,"."),0))
- Begin DoDot:1
- +2 SET (X,DINUM)=$PIECE(PSDATE,".")
- SET DIC="^PS(59.1,"
- SET DIC(0)="L"
- KILL DD,DO
- DO FILE^DICN
- KILL DD,DO
- +3 SET ^PS(59.1,$PIECE(PSDATE,"."),1,0)="^59.11PA^"
- +4 FOR I=0:0
- SET I=$ORDER(^PS(59,I))
- if 'I
- QUIT
- SET ^PS(59.1,$PIECE(PSDATE,"."),1,I,0)=I_"^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0"
- SET ^PS(59.1,$PIECE(PSDATE,"."),1,"B",I,I)=""
- Begin DoDot:2
- +5 SET $PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,0),"^",3)=I
- SET $PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,0),"^",4)=($PIECE(^PS(59.1,$PIECE(PSDATE,"."),1,0),"^",4)+1)
- End DoDot:2
- End DoDot:1
- +6 QUIT
