PRCPSMGO.m

PRCPSMGO ;WISC/RFJ/DL-create,batch,transmit code sheet ; 1/30/98

V ;;5.1;IFCAP;;Oct 20, 2000

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

 Q

 ;

 ;

CODESHT(V1,V2,V3) ;  create,batch,transmit v1=station number,

 ;  v2=trancode (ADJ,etc), v3=reference number for control string

 ;  ^tmp($j,"string",#) stores code sheets where # range is 1 and up

 ;  if $d(ztqueued) return prcpcs(n)=code sheet number, prcpcs(b)=batch number

 I '$O(^TMP($J,"STRING",0)) Q

 I 'V1!(V2="") Q

 N %,%I,DISYS,PRC,PRCF,PRCFASYS,PRCFA,PRCPTASK,STRING,X

 S:$D(ZTQUEUED) PRCPTASK=1 D CONTROL^PRCPSMS0(V1,V2,V3) Q:STRING=""

 S %=0 F X=0:1 S %=$O(^TMP($J,"STRING",%)) Q:'%  S:'$O(^TMP($J,"STRING",%)) ^(%)=^TMP($J,"STRING",%)_"$"

 I V2="REP"!(V2="ISS")!(V2="RET")!(V2="BAL") D LINECNT^PRCPSMS0(X,V3) S STRING=STRING_STRING("LC")

 S PRC("SITE")=V1,PRC("PER")=DUZ D NOW^%DTC

 S PRC("FY")=$E(X,2,3) S:+$E(X,4,5)>9 PRC("FY")=$E(100+PRC("FY")+1,2,3)

 S PRCFA("STRING")=STRING,PRCFASYS="ISM",PRCFA("TTF")=V2 W:'$G(PRCPTASK) !!,"creating ISMS code sheet ..." D ^PRCFACX2 Q:'$D(PRCFA("CSNAME"))

 W:'$G(PRCPTASK) "  CODE SHEET NUMBER: ",PRCFA("CSNAME") S:$G(PRCPTASK) PRCPCS("N")=PRCFA("CSNAME")

 W:'$G(PRCPTASK) !?5,"batching code sheet ..." D ^PRCFACB Q:'$D(PRCF("BTCH"))  W:'$G(PRCPTASK) "  BATCH NUMBER: ",PRCF("BTCH") S:$G(PRCPTASK) PRCPCS("B")=PRCF("BTCH")

 W:'$G(PRCPTASK) !?5,"transmit code sheet ...  QUEUED" D ^PRCFACBT

 K ^TMP($J,"STRING")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCPSMGO   1461     printed  Apr 09, 2024@21:19:09                                                                                                                                                                                                    Page 2

PRCPSMGO  ;WISC/RFJ/DL-create,batch,transmit code sheet ; 1/30/98

V         ;;5.1;IFCAP;;Oct 20, 2000

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

 +2        QUIT 

 +3       ;

 +4       ;

CODESHT(V1,V2,V3) ;  create,batch,transmit v1=station number,

 +1       ;  v2=trancode (ADJ,etc), v3=reference number for control string

 +2       ;  ^tmp($j,"string",#) stores code sheets where # range is 1 and up

 +3       ;  if $d(ztqueued) return prcpcs(n)=code sheet number, prcpcs(b)=batch number

 +4        IF '$ORDER(^TMP($JOB,"STRING",0))

               QUIT 

 +5        IF 'V1!(V2="")

               QUIT 

 +6        NEW %,%I,DISYS,PRC,PRCF,PRCFASYS,PRCFA,PRCPTASK,STRING,X

 +7        if $DATA(ZTQUEUED)

               SET PRCPTASK=1

           DO CONTROL^PRCPSMS0(V1,V2,V3)

           if STRING=""

               QUIT 

 +8        SET %=0

           FOR X=0:1

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

               if '%

                   QUIT 

               if '$ORDER(^TMP($JOB,"STRING",%))

                   SET ^(%)=^TMP($JOB,"STRING",%)_"$"

 +9        IF V2="REP"!(V2="ISS")!(V2="RET")!(V2="BAL")

               DO LINECNT^PRCPSMS0(X,V3)

               SET STRING=STRING_STRING("LC")

 +10       SET PRC("SITE")=V1

           SET PRC("PER")=DUZ

           DO NOW^%DTC

 +11       SET PRC("FY")=$EXTRACT(X,2,3)

           if +$EXTRACT(X,4,5)>9

               SET PRC("FY")=$EXTRACT(100+PRC("FY")+1,2,3)

 +12       SET PRCFA("STRING")=STRING

           SET PRCFASYS="ISM"

           SET PRCFA("TTF")=V2

           if '$GET(PRCPTASK)

               WRITE !!,"creating ISMS code sheet ..."

           DO ^PRCFACX2

           if '$DATA(PRCFA("CSNAME"))

               QUIT 

 +13       if '$GET(PRCPTASK)

               WRITE "  CODE SHEET NUMBER: ",PRCFA("CSNAME")

           if $GET(PRCPTASK)

               SET PRCPCS("N")=PRCFA("CSNAME")

 +14       if '$GET(PRCPTASK)

               WRITE !?5,"batching code sheet ..."

           DO ^PRCFACB

           if '$DATA(PRCF("BTCH"))

               QUIT 

           if '$GET(PRCPTASK)

               WRITE "  BATCH NUMBER: ",PRCF("BTCH")

           if $GET(PRCPTASK)

               SET PRCPCS("B")=PRCF("BTCH")

 +15       if '$GET(PRCPTASK)

               WRITE !?5,"transmit code sheet ...  QUEUED"

           DO ^PRCFACBT

 +16       KILL ^TMP($JOB,"STRING")

 +17       QUIT