- PRCPAWC0 ;WISC/RFJ-adjustment code sheets create and trans ;9.9.97
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- CODESHTS(INVPT,TRANID) ; create and transmit code sheets
- ; for invpt and transaction register id
- N %,%H,%X,%Y,ACCT,DA,DATA,INVVALUE,ISMSCNT,ISMSFLAG,ITEMDA,NSN,PRCPXMZ,QSIGN,QTY,SELVALUE,STRING,VOUCHER,VSIGN
- S ISMSFLAG=$$ISMSFLAG^PRCPUX2(PRC("SITE"))
- K ^TMP($J,"PRCPAWN1")
- S ISMSCNT=0
- S DA=0 F S DA=$O(^PRCP(445.2,"T",INVPT,TRANID,DA)) Q:'DA S DATA=$G(^PRCP(445.2,DA,0)) I DATA'="" D
- . I '$D(VOUCHER),$L($P(DATA,"^",15)) S VOUCHER=$P(DATA,"^",15)
- . S ITEMDA=+$P(DATA,"^",5) I 'ITEMDA Q
- . S NSN=$$NSN^PRCPUX1(ITEMDA),ACCT=$$ACCT1^PRCPUX1($E(NSN,1,4))
- . S QTY=+$P(DATA,"^",7),INVVALUE=+$P(DATA,"^",22),SELVALUE=+$P(DATA,"^",23)
- . I ISMSFLAG=2 D ISMS Q
- . D LOG
- ;
- ; transmit isms code sheets
- I ISMSFLAG=2,ISMSCNT D
- . K ^TMP($J,"STRING")
- . S %X="^TMP("_$J_",""PRCPAWN1"",",%Y="^TMP("_$J_",""STRING""," D %XY^%RCR
- . D CODESHT^PRCPSMGO(PRC("SITE"),"ADJ",VOUCHER)
- ;
- ; transmit log code sheets to isms
- I ISMSFLAG'=2,ISMSCNT D
- . K ^TMP($J,"STRING")
- . S %X="^TMP("_$J_",""PRCPAWN1"",",%Y="^TMP("_$J_",""STRING""," D %XY^%RCR
- . D TRANSMIT^PRCPSMCL(PRC("SITE"),605,"LOG")
- . W !!?4,"LOG 605 Transmitted in MailMan Messages:" I $D(PRCPXMZ) S %=0 F S %=$O(PRCPXMZ(%)) Q:'% W " ",PRCPXMZ(%)," "
- K ^TMP($J,"PRCPAWN1"),^TMP($J,"STRING")
- Q
- ;
- ;
- ISMS ; format isms code sheet
- I QTY D ADJUST^PRCPSMA0(INVPT,ITEMDA,QTY,"","","") I STRING("AT")'="" S ISMSCNT=ISMSCNT+1,^TMP($J,"PRCPAWN1",ISMSCNT)=STRING("AT")
- I INVVALUE D ADJUST^PRCPSMA0(INVPT,ITEMDA,"",INVVALUE,+$P($G(^PRCP(445,INVPT,1,ITEMDA,0)),"^",22),"") I STRING("AT")'="" S ISMSCNT=ISMSCNT+1,^TMP($J,"PRCPAWN1",ISMSCNT)=STRING("AT")
- Q
- ;
- ;
- LOG ; format log code sheets for isms
- S NSN=$E($TR($P(NSN,"-",2,4),"-")_" ",1,10)
- ; format quantity
- S QSIGN="+"
- I QTY<0 S QSIGN="-",QTY=QTY*-1
- S QTY=$S(QTY=0:" ",1:$E("00000",$L(QTY)+1,5)_QTY)
- ; format inventory value
- S VSIGN=QSIGN
- I INVVALUE S INVVALUE=$TR($J(INVVALUE,0,2),"."),VSIGN="+" I INVVALUE<0 S VSIGN="-",INVVALUE=INVVALUE*-1
- S INVVALUE=$S('INVVALUE:" ",1:$E("0000000",$L(INVVALUE)+1,7)_INVVALUE)
- ; build code sheets
- S %="",$P(%," ",80)=""
- I '$D(VOUCHER) S VOUCHER=" "
- I QSIGN=VSIGN S ISMSCNT=ISMSCNT+1,^TMP($J,"PRCPAWN1",ISMSCNT)=" "_NSN_PRC("SITE")_"605A"_ACCT_QTY_INVVALUE_QSIGN_VOUCHER_$E(DT,4,7)_$E(DT,2,3)_$E(%,1,35) Q
- I +QTY S ISMSCNT=ISMSCNT+1,^TMP($J,"PRCPAWN1",ISMSCNT)=" "_NSN_PRC("SITE")_"605A"_ACCT_QTY_"0000000"_QSIGN_VOUCHER_$E(DT,4,7)_$E(DT,2,3)_$E(%,1,35)
- I +INVVALUE S ISMSCNT=ISMSCNT+1,^TMP($J,"PRCPAWN1",ISMSCNT)=" "_NSN_PRC("SITE")_"605A"_ACCT_"00000"_INVVALUE_VSIGN_VOUCHER_$E(DT,4,5)_$E(DT,6,7)_$E(DT,2,3)_$E(%,1,35)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPAWC0 2878 printed Feb 18, 2025@23:39:13 Page 2
- PRCPAWC0 ;WISC/RFJ-adjustment code sheets create and trans ;9.9.97
- +1 ;;5.1;IFCAP;;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- CODESHTS(INVPT,TRANID) ; create and transmit code sheets
- +1 ; for invpt and transaction register id
- +2 NEW %,%H,%X,%Y,ACCT,DA,DATA,INVVALUE,ISMSCNT,ISMSFLAG,ITEMDA,NSN,PRCPXMZ,QSIGN,QTY,SELVALUE,STRING,VOUCHER,VSIGN
- +3 SET ISMSFLAG=$$ISMSFLAG^PRCPUX2(PRC("SITE"))
- +4 KILL ^TMP($JOB,"PRCPAWN1")
- +5 SET ISMSCNT=0
- +6 SET DA=0
- FOR
- SET DA=$ORDER(^PRCP(445.2,"T",INVPT,TRANID,DA))
- if 'DA
- QUIT
- SET DATA=$GET(^PRCP(445.2,DA,0))
- IF DATA'=""
- Begin DoDot:1
- +7 IF '$DATA(VOUCHER)
- IF $LENGTH($PIECE(DATA,"^",15))
- SET VOUCHER=$PIECE(DATA,"^",15)
- +8 SET ITEMDA=+$PIECE(DATA,"^",5)
- IF 'ITEMDA
- QUIT
- +9 SET NSN=$$NSN^PRCPUX1(ITEMDA)
- SET ACCT=$$ACCT1^PRCPUX1($EXTRACT(NSN,1,4))
- +10 SET QTY=+$PIECE(DATA,"^",7)
- SET INVVALUE=+$PIECE(DATA,"^",22)
- SET SELVALUE=+$PIECE(DATA,"^",23)
- +11 IF ISMSFLAG=2
- DO ISMS
- QUIT
- +12 DO LOG
- End DoDot:1
- +13 ;
- +14 ; transmit isms code sheets
- +15 IF ISMSFLAG=2
- IF ISMSCNT
- Begin DoDot:1
- +16 KILL ^TMP($JOB,"STRING")
- +17 SET %X="^TMP("_$JOB_",""PRCPAWN1"","
- SET %Y="^TMP("_$JOB_",""STRING"","
- DO %XY^%RCR
- +18 DO CODESHT^PRCPSMGO(PRC("SITE"),"ADJ",VOUCHER)
- End DoDot:1
- +19 ;
- +20 ; transmit log code sheets to isms
- +21 IF ISMSFLAG'=2
- IF ISMSCNT
- Begin DoDot:1
- +22 KILL ^TMP($JOB,"STRING")
- +23 SET %X="^TMP("_$JOB_",""PRCPAWN1"","
- SET %Y="^TMP("_$JOB_",""STRING"","
- DO %XY^%RCR
- +24 DO TRANSMIT^PRCPSMCL(PRC("SITE"),605,"LOG")
- +25 WRITE !!?4,"LOG 605 Transmitted in MailMan Messages:"
- IF $DATA(PRCPXMZ)
- SET %=0
- FOR
- SET %=$ORDER(PRCPXMZ(%))
- if '%
- QUIT
- WRITE " ",PRCPXMZ(%)," "
- End DoDot:1
- +26 KILL ^TMP($JOB,"PRCPAWN1"),^TMP($JOB,"STRING")
- +27 QUIT
- +28 ;
- +29 ;
- ISMS ; format isms code sheet
- +1 IF QTY
- DO ADJUST^PRCPSMA0(INVPT,ITEMDA,QTY,"","","")
- IF STRING("AT")'=""
- SET ISMSCNT=ISMSCNT+1
- SET ^TMP($JOB,"PRCPAWN1",ISMSCNT)=STRING("AT")
- +2 IF INVVALUE
- DO ADJUST^PRCPSMA0(INVPT,ITEMDA,"",INVVALUE,+$PIECE($GET(^PRCP(445,INVPT,1,ITEMDA,0)),"^",22),"")
- IF STRING("AT")'=""
- SET ISMSCNT=ISMSCNT+1
- SET ^TMP($JOB,"PRCPAWN1",ISMSCNT)=STRING("AT")
- +3 QUIT
- +4 ;
- +5 ;
- LOG ; format log code sheets for isms
- +1 SET NSN=$EXTRACT($TRANSLATE($PIECE(NSN,"-",2,4),"-")_" ",1,10)
- +2 ; format quantity
- +3 SET QSIGN="+"
- +4 IF QTY<0
- SET QSIGN="-"
- SET QTY=QTY*-1
- +5 SET QTY=$SELECT(QTY=0:" ",1:$EXTRACT("00000",$LENGTH(QTY)+1,5)_QTY)
- +6 ; format inventory value
- +7 SET VSIGN=QSIGN
- +8 IF INVVALUE
- SET INVVALUE=$TRANSLATE($JUSTIFY(INVVALUE,0,2),".")
- SET VSIGN="+"
- IF INVVALUE<0
- SET VSIGN="-"
- SET INVVALUE=INVVALUE*-1
- +9 SET INVVALUE=$SELECT('INVVALUE:" ",1:$EXTRACT("0000000",$LENGTH(INVVALUE)+1,7)_INVVALUE)
- +10 ; build code sheets
- +11 SET %=""
- SET $PIECE(%," ",80)=""
- +12 IF '$DATA(VOUCHER)
- SET VOUCHER=" "
- +13 IF QSIGN=VSIGN
- SET ISMSCNT=ISMSCNT+1
- SET ^TMP($JOB,"PRCPAWN1",ISMSCNT)=" "_NSN_PRC("SITE")_"605A"_ACCT_QTY_INVVALUE_QSIGN_VOUCHER_$EXTRACT(DT,4,7)_$EXTRACT(DT,2,3)_$EXTRACT(%,1,35)
- QUIT
- +14 IF +QTY
- SET ISMSCNT=ISMSCNT+1
- SET ^TMP($JOB,"PRCPAWN1",ISMSCNT)=" "_NSN_PRC("SITE")_"605A"_ACCT_QTY_"0000000"_QSIGN_VOUCHER_$EXTRACT(DT,4,7)_$EXTRACT(DT,2,3)_$EXTRACT(%,1,35)
- +15 IF +INVVALUE
- SET ISMSCNT=ISMSCNT+1
- SET ^TMP($JOB,"PRCPAWN1",ISMSCNT)=" "_NSN_PRC("SITE")_"605A"_ACCT_"00000"_INVVALUE_VSIGN_VOUCHER_$EXTRACT(DT,4,5)_$EXTRACT(DT,6,7)_$EXTRACT(DT,2,3)_$EXTRACT(%,1,35)
- +16 QUIT