PSO52CLR.m

PSO52CLR ;BIR/DB - Encapsulation Routine ; 27 Feb 2008

 ;;7.0;OUTPATIENT PHARMACY;**299**;DEC 1997;Build 5

STAT(PSO) ;Return Status(#100) external format from Prescription (#52) file

 N PSOSTAT I $G(PSO)="" Q "UNKNOWN"

 S PSOSTAT=$$EXTERNAL^DILFD(52,100,,PSO)

 I $G(PSOSTAT)="" S PSOSTAT="UNKNOWN"

 Q PSOSTAT

 ;

NEPSRX() ;Return number of entries in PSRX

 N DA,DA1,DATE,DSUP,DFN,DRUG,NE,RDATE,TEMP

 S (DA,NE)=0

 F  S DA=+$O(^PSRX(DA)) Q:DA=0  D

 . S TEMP=$G(^PSRX(DA,0))

 . S DFN=$P(TEMP,U,2)

 . I DFN="" Q

 . S DRUG=$P(TEMP,U,6)

 . I DRUG="" Q

 . S DSUP=$P(TEMP,U,8)

 . I DSUP="" Q

 . S RDATE=+$P($G(^PSRX(DA,2)),U,13)

 . I RDATE>0 S NE=NE+1

 .;Process the refill mutiple.

 . S DA1=0

 . F  S DA1=+$O(^PSRX(DA,1,DA1)) Q:DA1=0  D

 .. S TEMP=$G(^PSRX(DA,1,DA1,0))

 .. S DSUP=+$P(TEMP,U,10)

 .. I DSUP="" Q

 .. S RDATE=+$P(TEMP,U,18)

 .. I RDATE>0 S NE=NE+1

 .;Process the partial fill multiple.

 . S DA1=0

 . F  S DA1=+$O(^PSRX(DA,"P",DA1)) Q:DA1=0  D

 .. S TEMP=$G(^PSRX(DA,"P",DA1,0))

 .. S DSUP=+$P(TEMP,U,10)

 .. I DSUP="" Q

 .. S RDATE=+$P(TEMP,U,19)

 .. I RDATE>0 S NE=NE+1

 K DA,DA1,DATE,DSUP,DFN,DRUG,RDATE,TEMP

 Q NE

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSO52CLR   1163     printed  Apr 09, 2024@21:37:14                                                                                                                                                                                                    Page 2

PSO52CLR  ;BIR/DB - Encapsulation Routine ; 27 Feb 2008

 +1       ;;7.0;OUTPATIENT PHARMACY;**299**;DEC 1997;Build 5

STAT(PSO) ;Return Status(#100) external format from Prescription (#52) file

 +1        NEW PSOSTAT

           IF $GET(PSO)=""

               QUIT "UNKNOWN"

 +2        SET PSOSTAT=$$EXTERNAL^DILFD(52,100,,PSO)

 +3        IF $GET(PSOSTAT)=""

               SET PSOSTAT="UNKNOWN"

 +4        QUIT PSOSTAT

 +5       ;

NEPSRX()  ;Return number of entries in PSRX

 +1        NEW DA,DA1,DATE,DSUP,DFN,DRUG,NE,RDATE,TEMP

 +2        SET (DA,NE)=0

 +3        FOR 

               SET DA=+$ORDER(^PSRX(DA))

               if DA=0

                   QUIT 

               Begin DoDot:1

 +4                SET TEMP=$GET(^PSRX(DA,0))

 +5                SET DFN=$PIECE(TEMP,U,2)

 +6                IF DFN=""

                       QUIT 

 +7                SET DRUG=$PIECE(TEMP,U,6)

 +8                IF DRUG=""

                       QUIT 

 +9                SET DSUP=$PIECE(TEMP,U,8)

 +10               IF DSUP=""

                       QUIT 

 +11               SET RDATE=+$PIECE($GET(^PSRX(DA,2)),U,13)

 +12               IF RDATE>0

                       SET NE=NE+1

 +13      ;Process the refill mutiple.

 +14               SET DA1=0

 +15               FOR 

                       SET DA1=+$ORDER(^PSRX(DA,1,DA1))

                       if DA1=0

                           QUIT 

                       Begin DoDot:2

 +16                       SET TEMP=$GET(^PSRX(DA,1,DA1,0))

 +17                       SET DSUP=+$PIECE(TEMP,U,10)

 +18                       IF DSUP=""

                               QUIT 

 +19                       SET RDATE=+$PIECE(TEMP,U,18)

 +20                       IF RDATE>0

                               SET NE=NE+1

                       End DoDot:2

 +21      ;Process the partial fill multiple.

 +22               SET DA1=0

 +23               FOR 

                       SET DA1=+$ORDER(^PSRX(DA,"P",DA1))

                       if DA1=0

                           QUIT 

                       Begin DoDot:2

 +24                       SET TEMP=$GET(^PSRX(DA,"P",DA1,0))

 +25                       SET DSUP=+$PIECE(TEMP,U,10)

 +26                       IF DSUP=""

                               QUIT 

 +27                       SET RDATE=+$PIECE(TEMP,U,19)

 +28                       IF RDATE>0

                               SET NE=NE+1

                       End DoDot:2

               End DoDot:1

 +29       KILL DA,DA1,DATE,DSUP,DFN,DRUG,RDATE,TEMP

 +30       QUIT NE