PSNPPIP1.m

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

 Q

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

 Q

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

 I PSNBND[":" D BREAK

 I PSNBND'[":" D BREAK1

 Q

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

 Q

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

 Q

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

 Q

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

 Q

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

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