APSPPT.m

APSPPT ; IHS/DSD/ENM - FIX PHARMACY PATIENT FILE ;  [ 09/03/97   1:30 PM ]

 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 ;

START ;

 F APSPPT("PAT")=0:0 S APSPPT("PAT")=$O(^PS(55,APSPPT("PAT"))) Q:'APSPPT("PAT")  D PT

END D EOJ

 Q

 ;---------------------------------------------------------------------

PT ;

 F APSPPTI=0:0 S APSPPTI=$O(^PS(55,APSPPT("PAT"),"P",APSPPTI)) Q:'APSPPTI  D CHECK

 K APSPPTI

 Q

 ;

CHECK ;

 F APSPPT("IRXN")=21788,21789,21790,21791,21792,21793 I ^PS(55,APSPPT("PAT"),"P",APSPPTI,0)=APSPPT("IRXN") D DELETE

 K APSPPT("IRXN")

 Q

DELETE ;

 W !,$P(^DPT(APSPPT("PAT"),0),U,1)_"    "_APSPPT("IRXN")

 S ^PS(55,APSPPT("PAT"),"P",0)=$P(^PS(55,APSPPT("PAT"),"P",0),U,1,3)_U_($P(^(0),U,4)-1)

 K ^PS(55,APSPPT("PAT"),"P",APSPPTI)

 F %=0:0 S %=$O(^PS(55,APSPPT("PAT"),"P","A",%)) Q:'%  I $D(^(%,APSPPT("IRXN"))) K ^(APSPPT("IRXN"))

 K:$D(^PS(55,APSPPT("PAT"),"P","CP",APSPPT("IRXN"))) ^(APSPPT("IRXN"))

 Q

 ;

EOJ ;

 K APSPPT,%

 Q

APSPPT    ; IHS/DSD/ENM - FIX PHARMACY PATIENT FILE ;  [ 09/03/97   1:30 PM ]

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 +2       ;

START     ;

 +1        FOR APSPPT("PAT")=0:0

               SET APSPPT("PAT")=$ORDER(^PS(55,APSPPT("PAT")))

               IF 'APSPPT("PAT")

                   QUIT 

               DO PT

END        DO EOJ

 +1        QUIT 

 +2       ;---------------------------------------------------------------------

PT        ;

 +1        FOR APSPPTI=0:0

               SET APSPPTI=$ORDER(^PS(55,APSPPT("PAT"),"P",APSPPTI))

               IF 'APSPPTI

                   QUIT 

               DO CHECK

 +2        KILL APSPPTI

 +3        QUIT 

 +4       ;

CHECK     ;

 +1        FOR APSPPT("IRXN")=21788,21789,21790,21791,21792,21793

               IF ^PS(55,APSPPT("PAT"),"P",APSPPTI,0)=APSPPT("IRXN")

                   DO DELETE

 +2        KILL APSPPT("IRXN")

 +3        QUIT 

DELETE    ;

 +1        WRITE !,$PIECE(^DPT(APSPPT("PAT"),0),U,1)_"    "_APSPPT("IRXN")

 +2        SET ^PS(55,APSPPT("PAT"),"P",0)=$PIECE(^PS(55,APSPPT("PAT"),"P",0),U,1,3)_U_($PIECE(^(0),U,4)-1)

 +3        KILL ^PS(55,APSPPT("PAT"),"P",APSPPTI)

 +4        FOR %=0:0

               SET %=$ORDER(^PS(55,APSPPT("PAT"),"P","A",%))

               IF '%

                   QUIT 

               IF $DATA(^(%,APSPPT("IRXN")))

                   KILL ^(APSPPT("IRXN"))

 +5        IF $DATA(^PS(55,APSPPT("PAT"),"P","CP",APSPPT("IRXN")))

               KILL ^(APSPPT("IRXN"))

 +6        QUIT 

 +7       ;

EOJ       ;

 +1        KILL APSPPT,%

 +2        QUIT