PSDUTL4.m

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

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