- PSOSUTL1 ;BIRM/WPB-Rx Suspense File Cross Reference Utility ; 12/7/95
- ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
- SDIVAS S:$P($G(^PS(52.5,DA,0)),"^",9)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",8))&($P($G(^PS(52.5,DA,"P")),"^"))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),X,$P(^PS(52.5,DA,0),"^",11),DA)=""
- I $P(^PS(52.5,DA,0),"^",7)="P"&($P($G(^PS(52.5,DA,0)),"^",9))&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",8)) D
- .K ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),X,$P(^PS(52.5,DA,0),"^",11),DA)
- .S ^PS(52.5,"APR",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),X,$P(^PS(52.5,DA,0),"^",11),DA)=""
- Q
- KDIVAS K:$P($G(^PS(52.5,DA,0)),"^",9)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",8))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),X,$P(^PS(52.5,DA,0),"^",11),DA)
- K:$P($G(^PS(52.5,DA,0)),"^",9)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",8))&($P($G(^PS(52.5,DA,0)),"^",7)="P") ^PS(52.5,"APR",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),X,$P(^PS(52.5,DA,0),"^",11),DA)
- Q
- SPDTAS S:$P($G(^PS(52.5,DA,0)),"^",9)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,"P")),"^"))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",X,$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)=""
- I $P(^PS(52.5,DA,0),"^",7)="P"&($P($G(^PS(52.5,DA,0)),"^",9))&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6)) D
- .K ^PS(52.5,"AS",X,$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)
- .S ^PS(52.5,"APR",X,$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)=""
- Q
- KPDTAS K:$P($G(^PS(52.5,DA,0)),"^",9)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",X,$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)
- K:$P($G(^PS(52.5,DA,0)),"^",9)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,0)),"^",7)="P") ^PS(52.5,"APR",X,$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)
- Q
- SPBYAS S:$P($G(^PS(52.5,DA,0)),"^",8)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,"P")),"^"))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),X,$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)=""
- I $P(^PS(52.5,DA,0),"^",7)="P"&($P($G(^PS(52.5,DA,0)),"^",8))&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6)) D
- .K ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),X,$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)
- .S ^PS(52.5,"APR",$P(^PS(52.5,DA,0),"^",8),X,$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)=""
- Q
- KPBYAS K:$P($G(^PS(52.5,DA,0)),"^",8)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),X,$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)
- K:$P($G(^PS(52.5,DA,0)),"^",8)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,0)),"^",7)="P") ^PS(52.5,"APR",$P(^PS(52.5,DA,0),"^",8),X,$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)
- Q
- SSEQAS S:$P($G(^PS(52.5,DA,0)),"^",8)&($P($G(^(0)),"^",9))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,"P")),"^"))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),X,DA)=""
- I $P(^PS(52.5,DA,0),"^",7)="P"&($P($G(^PS(52.5,DA,0)),"^",8))&($P($G(^(0)),"^",9))&($P($G(^(0)),"^",6)) D
- .K ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),X,DA)
- .S ^PS(52.5,"APR",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),X,DA)=""
- Q
- KSEQAS K:$P($G(^PS(52.5,DA,0)),"^",8)&($P($G(^(0)),"^",9))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),X,DA)
- K:$P($G(^PS(52.5,DA,0)),"^",8)&($P($G(^(0)),"^",9))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,0)),"^",7)="P") ^PS(52.5,"APR",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),X,DA)
- Q
- SADL I $P($G(^PS(52.5,DA,0)),"^",8),$G(^PS(52.5,DA,"P")) S ^PS(52.5,"ADL",$E($P(^PS(52.5,DA,0),"^",8),1,7),DA)=""
- Q
- KADL I $P($G(^PS(52.5,DA,0)),"^",8),$G(^PS(52.5,DA,"P")) K ^PS(52.5,"ADL",$E($P(^PS(52.5,DA,0),"^",8),1,7),DA)
- Q
- PSOSUTL1 ;BIRM/WPB-Rx Suspense File Cross Reference Utility ; 12/7/95
- +1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
- SDIVAS IF $PIECE($GET(^PS(52.5,DA,0)),"^",9)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",8))&($PIECE($GET(^PS(52.5,DA,"P")),"^"))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
- SET ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),X,$PIECE(^PS(52.5,DA,0),"^",11),DA)=""
- +1 IF $PIECE(^PS(52.5,DA,0),"^",7)="P"&($PIECE($GET(^PS(52.5,DA,0)),"^",9))&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",8))
- Begin DoDot:1
- +2 KILL ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),X,$PIECE(^PS(52.5,DA,0),"^",11),DA)
- +3 SET ^PS(52.5,"APR",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),X,$PIECE(^PS(52.5,DA,0),"^",11),DA)=""
- End DoDot:1
- +4 QUIT
- KDIVAS IF $PIECE($GET(^PS(52.5,DA,0)),"^",9)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",8))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
- KILL ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),X,$PIECE(^PS(52.5,DA,0),"^",11),DA)
- +1 IF $PIECE($GET(^PS(52.5,DA,0)),"^",9)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",8))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="P")
- KILL ^PS(52.5,"APR",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),X,$PIECE(^PS(52.5,DA,0),"^",11),DA)
- +2 QUIT
- SPDTAS IF $PIECE($GET(^PS(52.5,DA,0)),"^",9)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,"P")),"^"))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
- SET ^PS(52.5,"AS",X,$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)=""
- +1 IF $PIECE(^PS(52.5,DA,0),"^",7)="P"&($PIECE($GET(^PS(52.5,DA,0)),"^",9))&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))
- Begin DoDot:1
- +2 KILL ^PS(52.5,"AS",X,$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)
- +3 SET ^PS(52.5,"APR",X,$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)=""
- End DoDot:1
- +4 QUIT
- KPDTAS IF $PIECE($GET(^PS(52.5,DA,0)),"^",9)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
- KILL ^PS(52.5,"AS",X,$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)
- +1 IF $PIECE($GET(^PS(52.5,DA,0)),"^",9)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="P")
- KILL ^PS(52.5,"APR",X,$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)
- +2 QUIT
- SPBYAS IF $PIECE($GET(^PS(52.5,DA,0)),"^",8)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,"P")),"^"))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
- SET ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),X,$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)=""
- +1 IF $PIECE(^PS(52.5,DA,0),"^",7)="P"&($PIECE($GET(^PS(52.5,DA,0)),"^",8))&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))
- Begin DoDot:1
- +2 KILL ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),X,$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)
- +3 SET ^PS(52.5,"APR",$PIECE(^PS(52.5,DA,0),"^",8),X,$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)=""
- End DoDot:1
- +4 QUIT
- KPBYAS IF $PIECE($GET(^PS(52.5,DA,0)),"^",8)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
- KILL ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),X,$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)
- +1 IF $PIECE($GET(^PS(52.5,DA,0)),"^",8)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="P")
- KILL ^PS(52.5,"APR",$PIECE(^PS(52.5,DA,0),"^",8),X,$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)
- +2 QUIT
- SSEQAS IF $PIECE($GET(^PS(52.5,DA,0)),"^",8)&($PIECE($GET(^(0)),"^",9))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,"P")),"^"))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
- SET ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),X,DA)=""
- +1 IF $PIECE(^PS(52.5,DA,0),"^",7)="P"&($PIECE($GET(^PS(52.5,DA,0)),"^",8))&($PIECE($GET(^(0)),"^",9))&($PIECE($GET(^(0)),"^",6))
- Begin DoDot:1
- +2 KILL ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),X,DA)
- +3 SET ^PS(52.5,"APR",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),X,DA)=""
- End DoDot:1
- +4 QUIT
- KSEQAS IF $PIECE($GET(^PS(52.5,DA,0)),"^",8)&($PIECE($GET(^(0)),"^",9))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
- KILL ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),X,DA)
- +1 IF $PIECE($GET(^PS(52.5,DA,0)),"^",8)&($PIECE($GET(^(0)),"^",9))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="P")
- KILL ^PS(52.5,"APR",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),X,DA)
- +2 QUIT
- SADL IF $PIECE($GET(^PS(52.5,DA,0)),"^",8)
- IF $GET(^PS(52.5,DA,"P"))
- SET ^PS(52.5,"ADL",$EXTRACT($PIECE(^PS(52.5,DA,0),"^",8),1,7),DA)=""
- +1 QUIT
- KADL IF $PIECE($GET(^PS(52.5,DA,0)),"^",8)
- IF $GET(^PS(52.5,DA,"P"))
- KILL ^PS(52.5,"ADL",$EXTRACT($PIECE(^PS(52.5,DA,0),"^",8),1,7),DA)
- +1 QUIT
