- PSDUTL4 ;BIR/JPW-Utility FM and X-Refs (cont'd) ; 22 Jun 94
- ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- SAD ;sets 'AD' x-ref on field 2 in file 58.89
- S PSDNL=+$P(^PSD(58.89,DA,0),"^",6) I 'PSDNL K PSDNL Q
- S ^PSD(58.89,"AD",X,PSDNL,DA)="" K PSDNL
- Q
- KAD ;kills 'AD' x-ref on field 2 in file 58.89
- S PSDNL=+$P(^PSD(58.89,DA,0),"^",6) I 'PSDNL K PSDNL Q
- K ^PSD(58.89,"AD",X,PSDNL,DA),PSDNL
- Q
- SAD1 ;sets 'AD' x-ref on field 6 in file 58.89
- S PSDDAT=+$P(^PSD(58.89,DA,0),"^",3) I 'PSDDAT K PSDDAT Q
- S ^PSD(58.89,"AD",PSDDAT,X,DA)="" K PSDDAT
- Q
- KAD1 ;kills 'AD' x-ref on field 6 in file 58.89
- S PSDDAT=+$P(^PSD(58.89,DA,0),"^",3) I 'PSDDAT K PSDDAT Q
- K ^PSD(58.89,"AD",PSDDAT,X,DA),PSDDAT
- Q
- SAE ;sets 'AE' x-ref on field 4 in file 58.89
- S PSDNL=+$P(^PSD(58.89,DA,0),"^",6) I 'PSDNL K PSDNL Q
- S ^PSD(58.89,"AE",X,PSDNL,DA)="" K PSDNL
- Q
- KAE ;kills 'AE' x-ref on field 4 in file 58.89
- S PSDNL=+$P(^PSD(58.89,DA,0),"^",6) I 'PSDNL K PSDNL Q
- K ^PSD(58.89,"AE",X,PSDNL,DA),PSDNL
- Q
- SAE1 ;sets 'AE' x-ref on field 6 in file 58.89
- S PSDDAT=+$P(^PSD(58.89,DA,0),"^",5) I 'PSDDAT K PSDDAT Q
- S ^PSD(58.89,"AE",PSDDAT,X,DA)="" K PSDDAT
- Q
- KAE1 ;kills 'AE' x-ref on field 6 in file 58.89
- S PSDDAT=+$P(^PSD(58.89,DA,0),"^",5) I 'PSDDAT K PSDDAT Q
- K ^PSD(58.89,"AE",PSDDAT,X,DA),PSDDAT
- Q
- SAK ;sets 'AK' x-ref on field 21 in file 58.81
- S PSDNL=+$P(^PSD(58.81,DA,0),"^",18) I 'PSDNL K PSDNL Q
- S ^PSD(58.81,"AK",X,PSDNL,DA)="" K PSDNL
- Q
- KAK ;kills 'AK' x-ref on field 21 in file 58.81
- S PSDNL=+$P(^PSD(58.81,DA,0),"^",18) I 'PSDNL K PSDNL Q
- K ^PSD(58.81,"AK",X,PSDNL,DA),PSDNL
- Q
- SAK1 ;sets 'AK' x-ref on field 17 in file 58.81
- S PSDDAT=+$P($G(^PSD(58.81,DA,1)),"^",4) I 'PSDDAT K PSDDAT Q
- S ^PSD(58.81,"AK",PSDDAT,X,DA)="" K PSDDAT
- Q
- KAK1 ;kills 'AK' x-ref on field 17 in file 58.81
- S PSDDAT=+$P($G(^PSD(58.81,DA,1)),"^",4) I 'PSDDAT K PSDDAT Q
- K ^PSD(58.81,"AK",PSDDAT,X,DA),PSDDAT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDUTL4 1942 printed Feb 18, 2025@23:15:45 Page 2
- PSDUTL4 ;BIR/JPW-Utility FM and X-Refs (cont'd) ; 22 Jun 94
- +1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- SAD ;sets 'AD' x-ref on field 2 in file 58.89
- +1 SET PSDNL=+$PIECE(^PSD(58.89,DA,0),"^",6)
- IF 'PSDNL
- KILL PSDNL
- QUIT
- +2 SET ^PSD(58.89,"AD",X,PSDNL,DA)=""
- KILL PSDNL
- +3 QUIT
- KAD ;kills 'AD' x-ref on field 2 in file 58.89
- +1 SET PSDNL=+$PIECE(^PSD(58.89,DA,0),"^",6)
- IF 'PSDNL
- KILL PSDNL
- QUIT
- +2 KILL ^PSD(58.89,"AD",X,PSDNL,DA),PSDNL
- +3 QUIT
- SAD1 ;sets 'AD' x-ref on field 6 in file 58.89
- +1 SET PSDDAT=+$PIECE(^PSD(58.89,DA,0),"^",3)
- IF 'PSDDAT
- KILL PSDDAT
- QUIT
- +2 SET ^PSD(58.89,"AD",PSDDAT,X,DA)=""
- KILL PSDDAT
- +3 QUIT
- KAD1 ;kills 'AD' x-ref on field 6 in file 58.89
- +1 SET PSDDAT=+$PIECE(^PSD(58.89,DA,0),"^",3)
- IF 'PSDDAT
- KILL PSDDAT
- QUIT
- +2 KILL ^PSD(58.89,"AD",PSDDAT,X,DA),PSDDAT
- +3 QUIT
- SAE ;sets 'AE' x-ref on field 4 in file 58.89
- +1 SET PSDNL=+$PIECE(^PSD(58.89,DA,0),"^",6)
- IF 'PSDNL
- KILL PSDNL
- QUIT
- +2 SET ^PSD(58.89,"AE",X,PSDNL,DA)=""
- KILL PSDNL
- +3 QUIT
- KAE ;kills 'AE' x-ref on field 4 in file 58.89
- +1 SET PSDNL=+$PIECE(^PSD(58.89,DA,0),"^",6)
- IF 'PSDNL
- KILL PSDNL
- QUIT
- +2 KILL ^PSD(58.89,"AE",X,PSDNL,DA),PSDNL
- +3 QUIT
- SAE1 ;sets 'AE' x-ref on field 6 in file 58.89
- +1 SET PSDDAT=+$PIECE(^PSD(58.89,DA,0),"^",5)
- IF 'PSDDAT
- KILL PSDDAT
- QUIT
- +2 SET ^PSD(58.89,"AE",PSDDAT,X,DA)=""
- KILL PSDDAT
- +3 QUIT
- KAE1 ;kills 'AE' x-ref on field 6 in file 58.89
- +1 SET PSDDAT=+$PIECE(^PSD(58.89,DA,0),"^",5)
- IF 'PSDDAT
- KILL PSDDAT
- QUIT
- +2 KILL ^PSD(58.89,"AE",PSDDAT,X,DA),PSDDAT
- +3 QUIT
- SAK ;sets 'AK' x-ref on field 21 in file 58.81
- +1 SET PSDNL=+$PIECE(^PSD(58.81,DA,0),"^",18)
- IF 'PSDNL
- KILL PSDNL
- QUIT
- +2 SET ^PSD(58.81,"AK",X,PSDNL,DA)=""
- KILL PSDNL
- +3 QUIT
- KAK ;kills 'AK' x-ref on field 21 in file 58.81
- +1 SET PSDNL=+$PIECE(^PSD(58.81,DA,0),"^",18)
- IF 'PSDNL
- KILL PSDNL
- QUIT
- +2 KILL ^PSD(58.81,"AK",X,PSDNL,DA),PSDNL
- +3 QUIT
- SAK1 ;sets 'AK' x-ref on field 17 in file 58.81
- +1 SET PSDDAT=+$PIECE($GET(^PSD(58.81,DA,1)),"^",4)
- IF 'PSDDAT
- KILL PSDDAT
- QUIT
- +2 SET ^PSD(58.81,"AK",PSDDAT,X,DA)=""
- KILL PSDDAT
- +3 QUIT
- KAK1 ;kills 'AK' x-ref on field 17 in file 58.81
- +1 SET PSDDAT=+$PIECE($GET(^PSD(58.81,DA,1)),"^",4)
- IF 'PSDDAT
- KILL PSDDAT
- QUIT
- +2 KILL ^PSD(58.81,"AK",PSDDAT,X,DA),PSDDAT
- +3 QUIT