PRC5CON2 ;WISC/PLT-PRC5CON CONTINUE ; 09/12/95 11:24 AM
V ;;5.0;IFCAP;**27**;4/21/95
;QUIT ; invalid entry
;
EN ;start convert CALM code sheet to FMS
N PRCRI,PRCA,PRCB,PRCC,PRCD,PRCSITE,PRCPAT,PRCTD,PRCRD,PRCCNT
N A,B,C
S A=$$DATE^PRC0C($H,"H") I $P(A,"^",7)<2951014 D MMCALM("IFCAP V5 CALM CODE SHEET CONVERSION TOO EARLY^IFCAP V5 CALM CODE SHEETS CONVERSION USER","Please run this CALM code sheet conversion after 10/13/95.") QUIT
D:'$D(ZTQUEUED) EN^DDIOL("IFCAP V5 calm code sheet conversion starts at "_$$NOW^PRC5A)
;^TMP("PRCCALM",$J,SITE-PAT#)=earliest transaction date^earliest transmision date
K ^TMP("PRCCALM",$J)
S PRCRI(420.92)=$O(^PRCU(420.92,"B","PRCCALM","")) D:PRCRI(420.92)
. D DELETE^PRC0B1(.X,"420.92;^PRCU(420.92,;"_PRCRI(420.92))
. QUIT
;get from batch/print entry
S PRCA="95-100000" F S PRCA=$O(^PRCF(421.2,"E",PRCA)) QUIT:'PRCA D
. S PRCRI(421.2)=0 F S PRCRI(421.2)=$O(^PRCF(421.2,"E",PRCA,PRCRI(421.2))) QUIT:'PRCRI(421.2) I PRCRI(421.2) S PRCC=$G(^PRCF(421.2,PRCRI(421.2),0)) I $P(PRCC,"-",2)="CLM",$P(PRCC,"^",3)="B" D
.. S PRCC=$P(PRCC,"^")
.. S PRCRI(423)=0 F S PRCRI(423)=$O(^PRCF(423,"AD",PRCC,PRCRI(423))) QUIT:'PRCRI(423) D F423
. QUIT
;get code sheet from 423 if not batched/printed
S PRCRI(423)=0 F S PRCRI(423)=$O(^PRCF(423,"AC","N",PRCRI(423))) QUIT:'PRCRI(423) D F423
;copy ^TMP entry to file 420.92
S PRCRI(420.92)=$O(^PRCU(420.92,"B","PRCCALM","")) D:'PRCRI(420.92)
. N A
. S X="PRCCALM",X("DR")="1////IFCAP V4 PO 1996 CALM CODE SHEET;2///^S X=""N"""
. D ADD^PRC0B1(.X,.Y,"420.92;^PRCU(420.92,")
. I Y=-1 K Y I Y W:'$D(ZTQUEUED) !,"ERROR TRAP! CALL IRM/ISC SUPPORT."
. S PRCRI(420.92)=+Y
. QUIT
S PRCA="" F S PRCA=$O(^TMP("PRCCALM",$J,PRCA)) QUIT:'PRCA S PRCB=$G(^(PRCA)) D
. S PRCC=PRCA_"~"_$TR(PRCB,"^","~")
. S A="420.92;^PRCU(420.92,;"_PRCRI(420.92)_";3~420.923;^PRCU(420.92,"_PRCRI(420.92)_",1,"
. S X=0,X("DR")=".01///^S X=DA;1///^S X=PRCC"
. D ADD^PRC0B1(.X,.Y,A) I Y=-1 S PRCERR=102
. QUIT
D EDIT^PRC0B(.X,"420.92;^PRCU(420.92,;"_PRCRI(420.92),"2.5///^S X=""N""","LS")
S A="420.92;^PRCU(420.92,;"_PRCRI(420.92)_";4~420.924;^PRCU(420.92,"_PRCRI(420.92)_",2,"
S X="|NOWRAP|"
D ADD^PRC0B1(.X,.Y,A)
I Y=-1 K Y I Y W:'$D(ZTQUEUED) !,"ERROR TRAP! CALL IRM/ISC SUPPORT."
K ^TMP("PRCCALM",$J)
EN1 ;generate FMS documents
S PRCCNT=0
S PRCRI(420.92)=$O(^PRCU(420.92,"B","PRCCALM","")) I PRCRI(420.92) S PRCA=^PRCU(420.92,PRCRI(420.92),0) D:$P(PRCA,"^",4)]""&($P(PRCA,"^",6)="")
. D ED^PRC5B1(PRCRI(420.92),1)
. S PRCRI(420.923)=0
. F S PRCRI(420.923)=$O(^PRCU(420.92,PRCRI(420.92),1,PRCRI(420.923))) Q:'PRCRI(420.923) D:$P(^(PRCRI(420.923),0),"^",2)="" FMSDOC(PRCRI(420.92),PRCRI(420.923))
. D ED^PRC5B1(PRCRI(420.92),2)
. QUIT
D MMCALM("IFCAP V5 CALM CODE SHEETS CONVERSION DONE^IFCAP V5 CALM CODE SHEETS CONVERSION USER","IFCAP V5 CALM code sheets conversion done. Total FMS documents = "_PRCCNT)
D:'$D(ZTQUEUED) EN^DDIOL("IFCAP V5 CALM code sheet conversion ends at "_$$NOW^PRC5A)
QUIT
;
F423 ;get entry in file 423
S PRCD=$G(^PRCF(423,PRCRI(423),0)),PRCRD=$G(^("TRANS"))
QUIT:PRCD=""!(PRCRD="")
S PRCSITE=$P(PRCD,"^",2),PRCPAT=$P(PRCD,"^",6),PRCTD=$$DATE^PRC0C($P(PRCD,"^",5),"E"),PRCTD=$P(PRCTD,"^",7),PRCRD=$P(PRCRD,"^",3)
W:'$D(ZTQUEUED) !,PRCD,!,PRCRI(423)," ",PRCTD," ",PRCSITE," ",PRCPAT
QUIT:$P(PRCD,"^",10)'="CLM" QUIT:PRCRD<2951001!'PRCRD
S A=$G(^TMP("PRCCALM",$J,PRCSITE_"-"_PRCPAT))
I A]"" S:$P(A,"^")>PRCTD $P(A,"^")=PRCTD S:$P(A,"^",2)>PRCRD $P(A,"^",2)=PRCRD
I A="" S $P(A,"^")=PRCTD,$P(A,"^",2)=PRCRD
S ^TMP("PRCCALM",$J,PRCSITE_"-"_PRCPAT)=A
QUIT
;
FMSDOC(PRCA,PRCB) ;PRCA=ri of file 420.92, prcb=ri of file 420.923
; generate FMS doc
N PRCRI,PRCC,PRCD,PRCE,A
S PRCRI(420.92)=PRCA,PRCRI(420.923)=PRCB
S A=^PRCU(420.92,PRCA,1,PRCB,1),PRCC=$P(A,"~",1),PRCD=$P(A,"~",3)
S PRCRI(442)=$O(^PRC(442,"B",PRCC,"")) QUIT:'PRCRI(442)
S PRCE=$G(^PRC(442,PRCRI(442),0))
I $P(PRCE,"^",2)=21 QUIT:'$P(PRCE,"^",12) S A=$G(^PRCS(410,$P(PRCE,"^",12),0)) QUIT:$P(A,"-",2)<96
I $P(PRCE,"^",2)'=21,$P($G(^PRC(442,PRCRI(442),1)),"^",15)<2951001,$D(^(6)) D QUIT
. S A="420.92;^PRCU(420.92,;"_PRCRI(420.92)_";4~420.924;^PRCU(420.92,"_PRCRI(420.92)_",2,"
. S X=PRCC_" - 1995 or earlier P.O. with Amendment, no FMS-doc generated."
. D ADD^PRC0B1(.X,.Y,A)
. I Y=-1 K Y I Y W:'$D(ZTQUEUED) !,"ERROR TRAP! CALL IRM/ISC SUPPORT."
. QUIT
S A=$P(PRCE,"^",15),A=$S(A>2950930:"E",1:"E")
D
. N PRCA,PRCB,PRCCON3
. S PRCCON3=1 D EN^PRC5CON3(PRCRI(442),A,PRCD) S PRCCNT=PRCCNT+1
. QUIT
D ED1^PRC5B1(PRCA,PRCB) ;edit convert field in file 420.923
QUIT
;
MMCALM(A,B) ;send CALM conversion done message
N X,Y
S X(1)=B
S Y(.5)="",Y(PRCDUZ)="",Y("G.CSFISMGMT@DOMAIN.EXT")=""
D MM^PRC0B2(A,"X(",.Y)
K PRCDUZ
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC5CON2 4834 printed Sep 23, 2025@19:36:05 Page 2
PRC5CON2 ;WISC/PLT-PRC5CON CONTINUE ; 09/12/95 11:24 AM
V ;;5.0;IFCAP;**27**;4/21/95
+1 ;QUIT ; invalid entry
+2 ;
EN ;start convert CALM code sheet to FMS
+1 NEW PRCRI,PRCA,PRCB,PRCC,PRCD,PRCSITE,PRCPAT,PRCTD,PRCRD,PRCCNT
+2 NEW A,B,C
+3 SET A=$$DATE^PRC0C($HOROLOG,"H")
IF $PIECE(A,"^",7)<2951014
DO MMCALM("IFCAP V5 CALM CODE SHEET CONVERSION TOO EARLY^IFCAP V5 CALM CODE SHEETS CONVERSION USER","Please run this CALM code sheet conversion after 10/13/95.")
QUIT
+4 if '$DATA(ZTQUEUED)
DO EN^DDIOL("IFCAP V5 calm code sheet conversion starts at "_$$NOW^PRC5A)
+5 ;^TMP("PRCCALM",$J,SITE-PAT#)=earliest transaction date^earliest transmision date
+6 KILL ^TMP("PRCCALM",$JOB)
+7 SET PRCRI(420.92)=$ORDER(^PRCU(420.92,"B","PRCCALM",""))
if PRCRI(420.92)
Begin DoDot:1
+8 DO DELETE^PRC0B1(.X,"420.92;^PRCU(420.92,;"_PRCRI(420.92))
+9 QUIT
End DoDot:1
+10 ;get from batch/print entry
+11 SET PRCA="95-100000"
FOR
SET PRCA=$ORDER(^PRCF(421.2,"E",PRCA))
if 'PRCA
QUIT
Begin DoDot:1
+12 SET PRCRI(421.2)=0
FOR
SET PRCRI(421.2)=$ORDER(^PRCF(421.2,"E",PRCA,PRCRI(421.2)))
if 'PRCRI(421.2)
QUIT
IF PRCRI(421.2)
SET PRCC=$GET(^PRCF(421.2,PRCRI(421.2),0))
IF $PIECE(PRCC,"-",2)="CLM"
IF $PIECE(PRCC,"^",3)="B"
Begin DoDot:2
+13 SET PRCC=$PIECE(PRCC,"^")
+14 SET PRCRI(423)=0
FOR
SET PRCRI(423)=$ORDER(^PRCF(423,"AD",PRCC,PRCRI(423)))
if 'PRCRI(423)
QUIT
DO F423
End DoDot:2
+15 QUIT
End DoDot:1
+16 ;get code sheet from 423 if not batched/printed
+17 SET PRCRI(423)=0
FOR
SET PRCRI(423)=$ORDER(^PRCF(423,"AC","N",PRCRI(423)))
if 'PRCRI(423)
QUIT
DO F423
+18 ;copy ^TMP entry to file 420.92
+19 SET PRCRI(420.92)=$ORDER(^PRCU(420.92,"B","PRCCALM",""))
if 'PRCRI(420.92)
Begin DoDot:1
+20 NEW A
+21 SET X="PRCCALM"
SET X("DR")="1////IFCAP V4 PO 1996 CALM CODE SHEET;2///^S X=""N"""
+22 DO ADD^PRC0B1(.X,.Y,"420.92;^PRCU(420.92,")
+23 IF Y=-1
KILL Y
IF Y
if '$DATA(ZTQUEUED)
WRITE !,"ERROR TRAP! CALL IRM/ISC SUPPORT."
+24 SET PRCRI(420.92)=+Y
+25 QUIT
End DoDot:1
+26 SET PRCA=""
FOR
SET PRCA=$ORDER(^TMP("PRCCALM",$JOB,PRCA))
if 'PRCA
QUIT
SET PRCB=$GET(^(PRCA))
Begin DoDot:1
+27 SET PRCC=PRCA_"~"_$TRANSLATE(PRCB,"^","~")
+28 SET A="420.92;^PRCU(420.92,;"_PRCRI(420.92)_";3~420.923;^PRCU(420.92,"_PRCRI(420.92)_",1,"
+29 SET X=0
SET X("DR")=".01///^S X=DA;1///^S X=PRCC"
+30 DO ADD^PRC0B1(.X,.Y,A)
IF Y=-1
SET PRCERR=102
+31 QUIT
End DoDot:1
+32 DO EDIT^PRC0B(.X,"420.92;^PRCU(420.92,;"_PRCRI(420.92),"2.5///^S X=""N""","LS")
+33 SET A="420.92;^PRCU(420.92,;"_PRCRI(420.92)_";4~420.924;^PRCU(420.92,"_PRCRI(420.92)_",2,"
+34 SET X="|NOWRAP|"
+35 DO ADD^PRC0B1(.X,.Y,A)
+36 IF Y=-1
KILL Y
IF Y
if '$DATA(ZTQUEUED)
WRITE !,"ERROR TRAP! CALL IRM/ISC SUPPORT."
+37 KILL ^TMP("PRCCALM",$JOB)
EN1 ;generate FMS documents
+1 SET PRCCNT=0
+2 SET PRCRI(420.92)=$ORDER(^PRCU(420.92,"B","PRCCALM",""))
IF PRCRI(420.92)
SET PRCA=^PRCU(420.92,PRCRI(420.92),0)
if $PIECE(PRCA,"^",4)]""&($PIECE(PRCA,"^",6)="")
Begin DoDot:1
+3 DO ED^PRC5B1(PRCRI(420.92),1)
+4 SET PRCRI(420.923)=0
+5 FOR
SET PRCRI(420.923)=$ORDER(^PRCU(420.92,PRCRI(420.92),1,PRCRI(420.923)))
if 'PRCRI(420.923)
QUIT
if $PIECE(^(PRCRI(420.923),0),"^",2)=""
DO FMSDOC(PRCRI(420.92),PRCRI(420.923))
+6 DO ED^PRC5B1(PRCRI(420.92),2)
+7 QUIT
End DoDot:1
+8 DO MMCALM("IFCAP V5 CALM CODE SHEETS CONVERSION DONE^IFCAP V5 CALM CODE SHEETS CONVERSION USER","IFCAP V5 CALM code sheets conversion done. Total FMS documents = "_PRCCNT)
+9 if '$DATA(ZTQUEUED)
DO EN^DDIOL("IFCAP V5 CALM code sheet conversion ends at "_$$NOW^PRC5A)
+10 QUIT
+11 ;
F423 ;get entry in file 423
+1 SET PRCD=$GET(^PRCF(423,PRCRI(423),0))
SET PRCRD=$GET(^("TRANS"))
+2 if PRCD=""!(PRCRD="")
QUIT
+3 SET PRCSITE=$PIECE(PRCD,"^",2)
SET PRCPAT=$PIECE(PRCD,"^",6)
SET PRCTD=$$DATE^PRC0C($PIECE(PRCD,"^",5),"E")
SET PRCTD=$PIECE(PRCTD,"^",7)
SET PRCRD=$PIECE(PRCRD,"^",3)
+4 if '$DATA(ZTQUEUED)
WRITE !,PRCD,!,PRCRI(423)," ",PRCTD," ",PRCSITE," ",PRCPAT
+5 if $PIECE(PRCD,"^",10)'="CLM"
QUIT
if PRCRD<2951001!'PRCRD
QUIT
+6 SET A=$GET(^TMP("PRCCALM",$JOB,PRCSITE_"-"_PRCPAT))
+7 IF A]""
if $PIECE(A,"^")>PRCTD
SET $PIECE(A,"^")=PRCTD
if $PIECE(A,"^",2)>PRCRD
SET $PIECE(A,"^",2)=PRCRD
+8 IF A=""
SET $PIECE(A,"^")=PRCTD
SET $PIECE(A,"^",2)=PRCRD
+9 SET ^TMP("PRCCALM",$JOB,PRCSITE_"-"_PRCPAT)=A
+10 QUIT
+11 ;
FMSDOC(PRCA,PRCB) ;PRCA=ri of file 420.92, prcb=ri of file 420.923
+1 ; generate FMS doc
+2 NEW PRCRI,PRCC,PRCD,PRCE,A
+3 SET PRCRI(420.92)=PRCA
SET PRCRI(420.923)=PRCB
+4 SET A=^PRCU(420.92,PRCA,1,PRCB,1)
SET PRCC=$PIECE(A,"~",1)
SET PRCD=$PIECE(A,"~",3)
+5 SET PRCRI(442)=$ORDER(^PRC(442,"B",PRCC,""))
if 'PRCRI(442)
QUIT
+6 SET PRCE=$GET(^PRC(442,PRCRI(442),0))
+7 IF $PIECE(PRCE,"^",2)=21
if '$PIECE(PRCE,"^",12)
QUIT
SET A=$GET(^PRCS(410,$PIECE(PRCE,"^",12),0))
if $PIECE(A,"-",2)<96
QUIT
+8 IF $PIECE(PRCE,"^",2)'=21
IF $PIECE($GET(^PRC(442,PRCRI(442),1)),"^",15)<2951001
IF $DATA(^(6))
Begin DoDot:1
+9 SET A="420.92;^PRCU(420.92,;"_PRCRI(420.92)_";4~420.924;^PRCU(420.92,"_PRCRI(420.92)_",2,"
+10 SET X=PRCC_" - 1995 or earlier P.O. with Amendment, no FMS-doc generated."
+11 DO ADD^PRC0B1(.X,.Y,A)
+12 IF Y=-1
KILL Y
IF Y
if '$DATA(ZTQUEUED)
WRITE !,"ERROR TRAP! CALL IRM/ISC SUPPORT."
+13 QUIT
End DoDot:1
QUIT
+14 SET A=$PIECE(PRCE,"^",15)
SET A=$SELECT(A>2950930:"E",1:"E")
+15 Begin DoDot:1
+16 NEW PRCA,PRCB,PRCCON3
+17 SET PRCCON3=1
DO EN^PRC5CON3(PRCRI(442),A,PRCD)
SET PRCCNT=PRCCNT+1
+18 QUIT
End DoDot:1
+19 ;edit convert field in file 420.923
DO ED1^PRC5B1(PRCA,PRCB)
+20 QUIT
+21 ;
MMCALM(A,B) ;send CALM conversion done message
+1 NEW X,Y
+2 SET X(1)=B
+3 SET Y(.5)=""
SET Y(PRCDUZ)=""
SET Y("G.CSFISMGMT@DOMAIN.EXT")=""
+4 DO MM^PRC0B2(A,"X(",.Y)
+5 KILL PRCDUZ
+6 QUIT
