PRCPSMCL.m

PRCPSMCL ;WISC/RFJ-create and transmit log code sheet from tmp      ;22 Mar 93

 ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ;

 ;

TRANSMIT(V1,V2,V3) ;transmit code sheets from tmp global

 ;  v1=station number

 ;  v2=transaction type

 ;  v3=1stQueue^2ndQueue^... (form LOG)

 ;  tmp($j,"string",1:n)=code sheet data

 ;  returns prcpxmz(sequence number)=mailman message number

 ;

 N %,COUNT,CSHEET,DATA,LINE,PRCPSITE,SEQUENCE,XMZ

 ;

 K ^TMP($J,"PRCPSMC0"),PRCPXMZ S PRCPSITE=+V1

 ;

 ;  move code sheets to message number in tmp global

 S SEQUENCE=1,LINE=1,(COUNT,CSHEET)=0 F  S CSHEET=$O(^TMP($J,"STRING",CSHEET)) Q:'CSHEET  S DATA=^(CSHEET),COUNT=COUNT+1 D

 .   ;

 .   ;  build message in tmp

 .   S ^TMP($J,"PRCPSMC0",SEQUENCE,LINE,0)=DATA,LINE=LINE+1

 .   ;

 .   ;  increment counters if line equals 100 (code sheets)

 .   I $O(^TMP($J,"STRING",CSHEET)),LINE=100 S SEQUENCE=SEQUENCE+1,LINE=1

 ;

 ;  transmit

 F COUNT=1:1:SEQUENCE Q:'$D(^TMP($J,"PRCPSMC0",COUNT))  D

 .   ;

 .   ;  create and transmit mail message

 .   D MAILMSG^PRCPSMCS(COUNT,SEQUENCE,V2,V3)

 .   S PRCPXMZ(COUNT)=+$G(XMZ)

 .   ;I $G(XMZ) S %=$O(^PRC(411,PRCPSITE,2,"AC","S","")) I %'="" D PRINT(XMZ,%)

 K ^TMP($J,"PRCPSMC0")

 Q

 ;

 ;

PRINT(V1,V2) ;  forward mailman message to printer devive

 ;  v1=mailman message number

 ;  v2=printer device ^ printer device ^ ...

 N C,DIC,ER,X,XMDT,XMDUZ,XMY,XMZ,ZTPAR

 S XMZ=+V1,XMDUZ=DUZ

 F %=1:1 Q:$P(V2,"^",%)=""  S XMY("D."_$P(V2,"^",%)_"@"_$G(^XMB("NETNAME")))=""

 D ENT1^XMD Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCPSMCL   1587     printed  Mar 13, 2025@21:20:40                                                                                                                                                                                                    Page 2

PRCPSMCL  ;WISC/RFJ-create and transmit log code sheet from tmp      ;22 Mar 93

 +1       ;;5.1;IFCAP;;Oct 20, 2000

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

 +4       ;

 +5       ;

TRANSMIT(V1,V2,V3) ;transmit code sheets from tmp global

 +1       ;  v1=station number

 +2       ;  v2=transaction type

 +3       ;  v3=1stQueue^2ndQueue^... (form LOG)

 +4       ;  tmp($j,"string",1:n)=code sheet data

 +5       ;  returns prcpxmz(sequence number)=mailman message number

 +6       ;

 +7        NEW %,COUNT,CSHEET,DATA,LINE,PRCPSITE,SEQUENCE,XMZ

 +8       ;

 +9        KILL ^TMP($JOB,"PRCPSMC0"),PRCPXMZ

           SET PRCPSITE=+V1

 +10      ;

 +11      ;  move code sheets to message number in tmp global

 +12       SET SEQUENCE=1

           SET LINE=1

           SET (COUNT,CSHEET)=0

           FOR 

               SET CSHEET=$ORDER(^TMP($JOB,"STRING",CSHEET))

               if 'CSHEET

                   QUIT 

               SET DATA=^(CSHEET)

               SET COUNT=COUNT+1

               Begin DoDot:1

 +13      ;

 +14      ;  build message in tmp

 +15               SET ^TMP($JOB,"PRCPSMC0",SEQUENCE,LINE,0)=DATA

                   SET LINE=LINE+1

 +16      ;

 +17      ;  increment counters if line equals 100 (code sheets)

 +18               IF $ORDER(^TMP($JOB,"STRING",CSHEET))

                       IF LINE=100

                           SET SEQUENCE=SEQUENCE+1

                           SET LINE=1

               End DoDot:1

 +19      ;

 +20      ;  transmit

 +21       FOR COUNT=1:1:SEQUENCE

               if '$DATA(^TMP($JOB,"PRCPSMC0",COUNT))

                   QUIT 

               Begin DoDot:1

 +22      ;

 +23      ;  create and transmit mail message

 +24               DO MAILMSG^PRCPSMCS(COUNT,SEQUENCE,V2,V3)

 +25               SET PRCPXMZ(COUNT)=+$GET(XMZ)

 +26      ;I $G(XMZ) S %=$O(^PRC(411,PRCPSITE,2,"AC","S","")) I %'="" D PRINT(XMZ,%)

               End DoDot:1

 +27       KILL ^TMP($JOB,"PRCPSMC0")

 +28       QUIT 

 +29      ;

 +30      ;

PRINT(V1,V2) ;  forward mailman message to printer devive

 +1       ;  v1=mailman message number

 +2       ;  v2=printer device ^ printer device ^ ...

 +3        NEW C,DIC,ER,X,XMDT,XMDUZ,XMY,XMZ,ZTPAR

 +4        SET XMZ=+V1

           SET XMDUZ=DUZ

 +5        FOR %=1:1

               if $PIECE(V2,"^",%)=""

                   QUIT 

               SET XMY("D."_$PIECE(V2,"^",%)_"@"_$GET(^XMB("NETNAME")))=""

 +6        DO ENT1^XMD

           QUIT