- 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
