IBERSP1 ;ALB/ARH - CREATE CHECK-OFF SHEET CPT LIST (CONTINUED) ; 11/5/91
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;continuation of COS print function: creates the preliminary forms that IBERSP then reformats and prints
;creates partially formated files that can then be reformated to fit any TOF to save time
;only called if these do not already exist ie. may not be called for every COS print
;external entry pt.
CREATE ;create linear temp file of CPT's for GRP, array can be reused each time GRP is printed
N GDATA,DC,LF,CW,PN,GPO,IFN,DATA,NAME,CODE,CD,CHG,CPO,PFN,IC,I,J,X,Y
Q:'$D(^IBE(350.7,GRP,0))!('$D(^IBE(350.71,"AG",GRP)))
S GDATA=^IBE(350.7,GRP,0),DC=$P(GDATA,"^",2),LF=$P(GDATA,"^",4),ADT=$S(+ADT:ADT,1:DT)
S X=$$FORMAT^IBEFUNC2(GRP),IC=$P(X,"^",1),CW=$P(X,"^",2),PN=$P(X,"^",3)
S ^TMP("IBRSC",$J,GRP,0)=$P(GDATA,"^",1),^TMP("IBRSC",$J,GRP)=$P(GDATA,"^",3)
S GPO="" F I=1:1 S GPO=$O(^IBE(350.71,"AG",GRP,GPO)) Q:GPO="" S IFN=+$O(^IBE(350.71,"AG",GRP,GPO,"")) S DATA=$G(^IBE(350.71,IFN,0)) D:DATA'="" C1
S X="" F Y=1:1:(CW-12) S X=X_"_"
S X="OTHER PROC: "_X,J=0 D LINE
Q
;
C1 ;set GROUPs catigories and procedures into temp file
S NAME=$E($P(DATA,"^",1),1,CW),CPO="",X=$J(NAME,CW/2+($L(NAME)/2)),J=0 D LINE
F J=1:1 S CPO=$O(^IBE(350.71,"AS",IFN,CPO)) Q:CPO="" S PFN=+$O(^IBE(350.71,"AS",IFN,CPO,"")) S DATA=$G(^IBE(350.71,PFN,0)) D:DATA'="" C2
Q
;
C2 ;set each procedure into temp file
S NAME=$E($P(DATA,"^",1),1,PN),NAME=NAME_$J("",(PN-$L(NAME))),CD=+$P(DATA,"^",6),CODE=$P($G(^ICPT(CD,0)),"^",1),CHG=""
S:LF=1 X=CODE_" "_NAME S:LF'=1 X=NAME_" "_CODE
I DC S CHG=$$CPTCHG^IBEFUNC1(CD,DIV,ADT),X=X_" "_$S(CHG="":$J(CHG,8),1:$J(CHG,8,2))
S X=X_" ( )" D LINE
Q
;
LINE ;saves line in the linear temp file, padded depending on GRP format
S ^TMP("IBRSC",$J,GRP,I,J)=$J("",IC)_X_$J("",(CW-$L(X)+IC))
Q
;
;external entry pt.
BOX ;create card box and header
N CTR,IC,HLN,VLN,I,X
S BOX=12,CTR=(IOM/2),IC=4 S ^TMP("IBRSC",$J,"B")=CTR
S X=CTR-IC,HLN="" F I=1:1:X S HLN=HLN_"="
S VLN=$J("",(CTR-2))_"||",HLN=$J("",IC)_HLN_$J("",IC) F I=1:1:BOX S ^TMP("IBRSC",$J,"B",I)=VLN_$J("",IC)
S ^TMP("IBRSC",$J,"B",I+1)=HLN
S ^(I)=^TMP("IBRSC",$J,"B",I)_"Date:",^(4)=^TMP("IBRSC",$J,"B",4)_$J("Ambulatory Surgery Check-Off Sheet",(CTR\2)+17)
Q
IBERSP1 ;ALB/ARH - CREATE CHECK-OFF SHEET CPT LIST (CONTINUED) ; 11/5/91
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;continuation of COS print function: creates the preliminary forms that IBERSP then reformats and prints
+5 ;creates partially formated files that can then be reformated to fit any TOF to save time
+6 ;only called if these do not already exist ie. may not be called for every COS print
+7 ;external entry pt.
CREATE ;create linear temp file of CPT's for GRP, array can be reused each time GRP is printed
+1 NEW GDATA,DC,LF,CW,PN,GPO,IFN,DATA,NAME,CODE,CD,CHG,CPO,PFN,IC,I,J,X,Y
+2 IF '$DATA(^IBE(350.7,GRP,0))!('$DATA(^IBE(350.71,"AG",GRP)))
QUIT
+3 SET GDATA=^IBE(350.7,GRP,0)
SET DC=$PIECE(GDATA,"^",2)
SET LF=$PIECE(GDATA,"^",4)
SET ADT=$SELECT(+ADT:ADT,1:DT)
+4 SET X=$$FORMAT^IBEFUNC2(GRP)
SET IC=$PIECE(X,"^",1)
SET CW=$PIECE(X,"^",2)
SET PN=$PIECE(X,"^",3)
+5 SET ^TMP("IBRSC",$JOB,GRP,0)=$PIECE(GDATA,"^",1)
SET ^TMP("IBRSC",$JOB,GRP)=$PIECE(GDATA,"^",3)
+6 SET GPO=""
FOR I=1:1
SET GPO=$ORDER(^IBE(350.71,"AG",GRP,GPO))
IF GPO=""
QUIT
SET IFN=+$ORDER(^IBE(350.71,"AG",GRP,GPO,""))
SET DATA=$GET(^IBE(350.71,IFN,0))
IF DATA'=""
DO C1
+7 SET X=""
FOR Y=1:1:(CW-12)
SET X=X_"_"
+8 SET X="OTHER PROC: "_X
SET J=0
DO LINE
+9 QUIT
+10 ;
C1 ;set GROUPs catigories and procedures into temp file
+1 SET NAME=$EXTRACT($PIECE(DATA,"^",1),1,CW)
SET CPO=""
SET X=$JUSTIFY(NAME,CW/2+($LENGTH(NAME)/2))
SET J=0
DO LINE
+2 FOR J=1:1
SET CPO=$ORDER(^IBE(350.71,"AS",IFN,CPO))
IF CPO=""
QUIT
SET PFN=+$ORDER(^IBE(350.71,"AS",IFN,CPO,""))
SET DATA=$GET(^IBE(350.71,PFN,0))
IF DATA'=""
DO C2
+3 QUIT
+4 ;
C2 ;set each procedure into temp file
+1 SET NAME=$EXTRACT($PIECE(DATA,"^",1),1,PN)
SET NAME=NAME_$JUSTIFY("",(PN-$LENGTH(NAME)))
SET CD=+$PIECE(DATA,"^",6)
SET CODE=$PIECE($GET(^ICPT(CD,0)),"^",1)
SET CHG=""
+2 IF LF=1
SET X=CODE_" "_NAME
IF LF'=1
SET X=NAME_" "_CODE
+3 IF DC
SET CHG=$$CPTCHG^IBEFUNC1(CD,DIV,ADT)
SET X=X_" "_$SELECT(CHG="":$JUSTIFY(CHG,8),1:$JUSTIFY(CHG,8,2))
+4 SET X=X_" ( )"
DO LINE
+5 QUIT
+6 ;
LINE ;saves line in the linear temp file, padded depending on GRP format
+1 SET ^TMP("IBRSC",$JOB,GRP,I,J)=$JUSTIFY("",IC)_X_$JUSTIFY("",(CW-$LENGTH(X)+IC))
+2 QUIT
+3 ;
+4 ;external entry pt.
BOX ;create card box and header
+1 NEW CTR,IC,HLN,VLN,I,X
+2 SET BOX=12
SET CTR=(IOM/2)
SET IC=4
SET ^TMP("IBRSC",$JOB,"B")=CTR
+3 SET X=CTR-IC
SET HLN=""
FOR I=1:1:X
SET HLN=HLN_"="
+4 SET VLN=$JUSTIFY("",(CTR-2))_"||"
SET HLN=$JUSTIFY("",IC)_HLN_$JUSTIFY("",IC)
FOR I=1:1:BOX
SET ^TMP("IBRSC",$JOB,"B",I)=VLN_$JUSTIFY("",IC)
+5 SET ^TMP("IBRSC",$JOB,"B",I+1)=HLN
+6 SET ^(I)=^TMP("IBRSC",$JOB,"B",I)_"Date:"
SET ^(4)=^TMP("IBRSC",$JOB,"B",4)_$JUSTIFY("Ambulatory Surgery Check-Off Sheet",(CTR\2)+17)
+7 QUIT
