- PSNCMOP ;BIR/DMA&WRT-print products marked for CMOP ; 12/07/98 14:33
- ;;4.0; NATIONAL DRUG FILE;**3**; 30 Oct 98
- PRELIM W !,"This report will print out all VA Product Names marked for CMOP transmission.",!,"You may either sort by VA Product Name or by VA Identifier.",!
- W "This information comes from the VA Products file (NATIONALLY MARKED).",!,?15,"*** This is a long report ***",!,"You may queue the report to print, if you wish.",!!
- K DIR S DIR(0)="SA^I:IDENTIFIER;N:NAME",DIR("A")="Sort by VA Identifier (I) or VA Product Name (N)? " D ^DIR G END:$D(DIRUT) S S=Y
- S ZTSAVE("S")="" D EN^XUTMDEVQ("GO^PSNCMOP","PRINT DRUGS MARKED FOR CMOP",.ZTSAVE) I POP W !,"No device selected",!
- END K DIR,S,X,Y,ZTSAVE,^TMP($J,"PSN") Q
- ;
- GO ;ENTRY POINT
- K ^TMP($J,"PSN") D @S
- S:$D(ZTQUEUED) ZTREQ="@" K DA,DIR,ID,LINE,NA,PG,PR,S,TD,UN,X0,X1,Y,^TMP($J) D ^%ZISC Q
- ;
- I ;SORT BY ID
- S DA=0 F S DA=$O(^PSNDF(50.68,DA)) Q:'DA S X0=^(DA,0),X1=^(1) I $P(X1,"^",3) S ID=$P(X1,"^",2),NA=$P(X0,"^",1),UN=$P(X1,"^",4),UN=$P($G(^PSNDF(50.64,+UN,0)),"^"),^TMP($J,"PSN",ID,NA,UN)=""
- S PG=1,TD=$TR($$HTE^XLFDT($H),"@"," "),$P(LINE,"-",IOM-1)="" D HEADID
- S ID="" F S ID=$O(^TMP($J,"PSN",ID)),NA="" Q:ID="" F S NA=$O(^TMP($J,"PSN",ID,NA)),UN="" Q:NA="" F S UN=$O(^TMP($J,"PSN",ID,NA,UN)) Q:UN="" W !,ID,?10,NA,?60,UN I $Y+4>IOSL D HEADID
- Q
- ;
- HEADID W:$Y @IOF W !,?12,"VA PRODUCT LIST",?IOM-35," ",TD," PAGE ",PG,!,"ID#",?10,"VA PRINT NAME",?55,"VA DISP UNIT",!,LINE,! S PG=PG+1 Q
- ;
- ;
- N ;SORT BY NAME
- S DA=0 F S DA=$O(^PSNDF(50.68,DA)) Q:'DA S X0=^(DA,0),X1=^(1) I $P(X1,"^",3)]"" S NA=$P(X0,"^"),PR=$P(X1,"^"),UN=$P(X1,"^",4),UN=$P($G(^PSNDF(50.64,+UN,0)),"^"),ID=$P(X1,"^",2),^TMP($J,"PSN",NA,PR,UN,ID)=""
- S PG=1,TD=$TR($$HTE^XLFDT($H),"@"," "),$P(LINE,"-",IOM-1)="" D HEADNA
- S NA="" F S NA=$O(^TMP($J,"PSN",NA)),PR="" Q:NA="" F S PR=$O(^TMP($J,"PSN",NA,PR)),UN="" Q:PR="" F S UN=$O(^TMP($J,"PSN",NA,PR,UN)),ID="" Q:UN="" F S ID=$O(^TMP($J,"PSN",NA,PR,UN,ID)) Q:ID="" D
- .W !,NA,!,?7,PR,?60,UN,?70,ID I $Y+4>IOSL D HEADNA
- Q
- ;
- HEADNA W:$Y @IOF W !,?12,"VA PRODUCT LIST",?IOM-35," ",TD," PAGE ",PG,!,"VA PRODUCT NAME",!,?5,"VA PRINT NAME",?55,"VA DISP UNIT",?70,"ID#",!,LINE,! S PG=PG+1 Q
- PSNCMOP ;BIR/DMA&WRT-print products marked for CMOP ; 12/07/98 14:33
- +1 ;;4.0; NATIONAL DRUG FILE;**3**; 30 Oct 98
- PRELIM WRITE !,"This report will print out all VA Product Names marked for CMOP transmission.",!,"You may either sort by VA Product Name or by VA Identifier.",!
- +1 WRITE "This information comes from the VA Products file (NATIONALLY MARKED).",!,?15,"*** This is a long report ***",!,"You may queue the report to print, if you wish.",!!
- +2 KILL DIR
- SET DIR(0)="SA^I:IDENTIFIER;N:NAME"
- SET DIR("A")="Sort by VA Identifier (I) or VA Product Name (N)? "
- DO ^DIR
- IF $DATA(DIRUT)
- GOTO END
- SET S=Y
- +3 SET ZTSAVE("S")=""
- DO EN^XUTMDEVQ("GO^PSNCMOP","PRINT DRUGS MARKED FOR CMOP",.ZTSAVE)
- IF POP
- WRITE !,"No device selected",!
- END KILL DIR,S,X,Y,ZTSAVE,^TMP($JOB,"PSN")
- QUIT
- +1 ;
- GO ;ENTRY POINT
- +1 KILL ^TMP($JOB,"PSN")
- DO @S
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL DA,DIR,ID,LINE,NA,PG,PR,S,TD,UN,X0,X1,Y,^TMP($JOB)
- DO ^%ZISC
- QUIT
- +3 ;
- I ;SORT BY ID
- +1 SET DA=0
- FOR
- SET DA=$ORDER(^PSNDF(50.68,DA))
- IF 'DA
- QUIT
- SET X0=^(DA,0)
- SET X1=^(1)
- IF $PIECE(X1,"^",3)
- SET ID=$PIECE(X1,"^",2)
- SET NA=$PIECE(X0,"^",1)
- SET UN=$PIECE(X1,"^",4)
- SET UN=$PIECE($GET(^PSNDF(50.64,+UN,0)),"^")
- SET ^TMP($JOB,"PSN",ID,NA,UN)=""
- +2 SET PG=1
- SET TD=$TRANSLATE($$HTE^XLFDT($HOROLOG),"@"," ")
- SET $PIECE(LINE,"-",IOM-1)=""
- DO HEADID
- +3 SET ID=""
- FOR
- SET ID=$ORDER(^TMP($JOB,"PSN",ID))
- SET NA=""
- IF ID=""
- QUIT
- FOR
- SET NA=$ORDER(^TMP($JOB,"PSN",ID,NA))
- SET UN=""
- IF NA=""
- QUIT
- FOR
- SET UN=$ORDER(^TMP($JOB,"PSN",ID,NA,UN))
- IF UN=""
- QUIT
- WRITE !,ID,?10,NA,?60,UN
- IF $Y+4>IOSL
- DO HEADID
- +4 QUIT
- +5 ;
- HEADID IF $Y
- WRITE @IOF
- WRITE !,?12,"VA PRODUCT LIST",?IOM-35," ",TD," PAGE ",PG,!,"ID#",?10,"VA PRINT NAME",?55,"VA DISP UNIT",!,LINE,!
- SET PG=PG+1
- QUIT
- +1 ;
- +2 ;
- N ;SORT BY NAME
- +1 SET DA=0
- FOR
- SET DA=$ORDER(^PSNDF(50.68,DA))
- IF 'DA
- QUIT
- SET X0=^(DA,0)
- SET X1=^(1)
- IF $PIECE(X1,"^",3)]""
- SET NA=$PIECE(X0,"^")
- SET PR=$PIECE(X1,"^")
- SET UN=$PIECE(X1,"^",4)
- SET UN=$PIECE($GET(^PSNDF(50.64,+UN,0)),"^")
- SET ID=$PIECE(X1,"^",2)
- SET ^TMP($JOB,"PSN",NA,PR,UN,ID)=""
- +2 SET PG=1
- SET TD=$TRANSLATE($$HTE^XLFDT($HOROLOG),"@"," ")
- SET $PIECE(LINE,"-",IOM-1)=""
- DO HEADNA
- +3 SET NA=""
- FOR
- SET NA=$ORDER(^TMP($JOB,"PSN",NA))
- SET PR=""
- IF NA=""
- QUIT
- FOR
- SET PR=$ORDER(^TMP($JOB,"PSN",NA,PR))
- SET UN=""
- IF PR=""
- QUIT
- FOR
- SET UN=$ORDER(^TMP($JOB,"PSN",NA,PR,UN))
- SET ID=""
- IF UN=""
- QUIT
- FOR
- SET ID=$ORDER(^TMP($JOB,"PSN",NA,PR,UN,ID))
- IF ID=""
- QUIT
- Begin DoDot:1
- +4 WRITE !,NA,!,?7,PR,?60,UN,?70,ID
- IF $Y+4>IOSL
- DO HEADNA
- End DoDot:1
- +5 QUIT
- +6 ;
- HEADNA IF $Y
- WRITE @IOF
- WRITE !,?12,"VA PRODUCT LIST",?IOM-35," ",TD," PAGE ",PG,!,"VA PRODUCT NAME",!,?5,"VA PRINT NAME",?55,"VA DISP UNIT",?70,"ID#",!,LINE,!
- SET PG=PG+1
- QUIT
