Routine: PSNPPIP1

PSNPPIP1 ;BIR/WRT-print a medication instruction sheet Part 2 ; 01/17/03 12:32

 ;;4.0; NATIONAL DRUG FILE;**62**; 30 Oct 98

 ; Reference to ^PS(59.7 supported by IA #2613

 ; Reference to ^PSDRUG supported by IA #221

BRANDNM ;Common Brand name of the drug the user wants a PMI sheet for

 S PSNBND=""

 I $D(^PS(PSNFILE2,+PSNENG,"C")) D NAMES,SPACE

NAMES S ^TMP($J,"W",CNTO)=PSNSP S CNTO=CNTO+1   ;Insert blank line

 F J=0:0 S J=$O(^PS(PSNFILE2,+PSNENG,"C",J)) Q:'J  D LOOP

LOOP S PSNBND=^PS(PSNFILE2,+PSNENG,"C",J,0)

 I PSNBND[":" D BREAK

 I PSNBND'[":" D BREAK1

SPACE I $D(^PS(PSNFILE2,+PSNENG,"C")) S ^TMP($J,"W",CNTO)=PSNSP S CNTO=CNTO+1  ; Insert Blank Line

BREAK S ^TMP($J,"W",CNTO)=$G(IOINHI)_$P(PSNBND,":")_$G(IOINORM)_": "_$G(IOINORM)_$P(PSNBND,":",2) S CNTO=CNTO+1

BREAK1 S ^TMP($J,"W",CNTO)=$G(IOINORM)_$P(PSNBND,":",1) S CNTO=CNTO+1

ONELN I $P($G(^PS(PSNFILE2,+PSNENG,PSNALPHA,0)),"^",3)=1 S PSNLAST=$P(^PS(PSNFILE2,+PSNENG,PSNALPHA,0),"^",3),LINE=^PS(PSNFILE2,+PSNENG,PSNALPHA,J,0) D BRKIT

BRKIT S ^TMP($J,"W",CNTO)=" "_$G(IOINHI)_$P(LINE,":")_$G(IOINORM)_":"_$G(IOINORM)_$P(LINE,":",2),CNTO=CNTO+1 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNPPIP1   1164     printed  Mar 13, 2025@21:29:21                                                                                                                                                                                                    Page 2

PSNPPIP1  ;BIR/WRT-print a medication instruction sheet Part 2 ; 01/17/03 12:32

 +1       ;;4.0; NATIONAL DRUG FILE;**62**; 30 Oct 98

 +2       ; Reference to ^PS(59.7 supported by IA #2613

 +3       ; Reference to ^PSDRUG supported by IA #221

 +4       ;

BRANDNM   ;Common Brand name of the drug the user wants a PMI sheet for

 +1       ;

 +2        SET PSNBND=""

 +3        IF $DATA(^PS(PSNFILE2,+PSNENG,"C"))

               DO NAMES

               DO SPACE

 +4        QUIT

NAMES     ;Insert blank line

           SET ^TMP($JOB,"W",CNTO)=PSNSP

           SET CNTO=CNTO+1

 +1        FOR J=0:0

               SET J=$ORDER(^PS(PSNFILE2,+PSNENG,"C",J))

               if 'J

                   QUIT

               DO LOOP

 +2        QUIT

LOOP       SET PSNBND=^PS(PSNFILE2,+PSNENG,"C",J,0)

 +1        IF PSNBND[":"

               DO BREAK

 +2        IF PSNBND'[":"

               DO BREAK1

 +3        QUIT

SPACE     ; Insert Blank Line

           IF $DATA(^PS(PSNFILE2,+PSNENG,"C"))

               SET ^TMP($JOB,"W",CNTO)=PSNSP

               SET CNTO=CNTO+1

 +1        QUIT

BREAK      SET ^TMP($JOB,"W",CNTO)=$GET(IOINHI)_$PIECE(PSNBND,":")_$GET(IOINORM)_": "_$GET(IOINORM)_$PIECE(PSNBND,":",2)

           SET CNTO=CNTO+1

 +1        QUIT

BREAK1     SET ^TMP($JOB,"W",CNTO)=$GET(IOINORM)_$PIECE(PSNBND,":",1)

           SET CNTO=CNTO+1

 +1        QUIT

ONELN      IF $PIECE($GET(^PS(PSNFILE2,+PSNENG,PSNALPHA,0)),"^",3)=1

               SET PSNLAST=$PIECE(^PS(PSNFILE2,+PSNENG,PSNALPHA,0),"^",3)

               SET LINE=^PS(PSNFILE2,+PSNENG,PSNALPHA,J,0)

               DO BRKIT

 +1        QUIT

BRKIT      SET ^TMP($JOB,"W",CNTO)=" "_$GET(IOINHI)_$PIECE(LINE,":")_$GET(IOINORM)_":"_$GET(IOINORM)_$PIECE(LINE,":",2)

           SET CNTO=CNTO+1

           QUIT

PSNPPIP1.m