| [613] | 1 | GMPLBLDF ; SLC/MKB -- Build Problem Selection List from IB Enc Form ;5/12/94 10:26
|
|---|
| 2 | ;;2.0;Problem List;;Aug 25, 1994
|
|---|
| 3 | EN ; Start here.
|
|---|
| 4 | S X="IBDF18" X ^%ZOSF("TEST") I '$T D Q
|
|---|
| 5 | . W !!,">>> The IB Encounter Form utility is not available.",!
|
|---|
| 6 | EN0 S GMPLFORM=$$GETFORM^IBDF18 G:'GMPLFORM EXIT
|
|---|
| 7 | W !,"Searching for the problems ..."
|
|---|
| 8 | S X=$$COPYFORM^IBDF18(+GMPLFORM,"GMPL"),GMPL(0)=X
|
|---|
| 9 | I 'X W !!,"No problems found. Please select another form.",! G EN0
|
|---|
| 10 | EN1 ; Create list to copy problems into
|
|---|
| 11 | S DIR(0)="FA^3:30",DIR("A")="LIST NAME: "
|
|---|
| 12 | S:'$D(^GMPL(125,"B",$P(GMPLFORM,U,2))) DIR("B")=$P(GMPLFORM,U,2)
|
|---|
| 13 | S DIR("?",1)="Enter the name you wish to give this list; use meaningful"
|
|---|
| 14 | S DIR("?")="text, as it will be used as a title when presenting this list."
|
|---|
| 15 | W !!,">>> Please create a new selection list in which to store these problems:"
|
|---|
| 16 | EN2 D ^DIR G:$D(DUOUT)!($D(DTOUT)) EXIT
|
|---|
| 17 | I $D(^GMPL(125,"B",Y)) W $C(7),!,"There is already a list by this name!",! G EN2
|
|---|
| 18 | S DIC="^GMPL(125,",DIC(0)="L",DIC("DR")=".02////"_DT,DLAYGO=125 K DD,DO
|
|---|
| 19 | D FILE^DICN I Y'>0 W !!,"ERROR -- Cannot create new list!",$C(7) G EXIT
|
|---|
| 20 | S GMPLSLST=$P(Y,U,1,2),DIE=DIC,DA=+Y,DR=".03 CLINIC" D ^DIE ; clinic
|
|---|
| 21 | EN3 ; Here we go ...
|
|---|
| 22 | W !!,"Copying problems from "_$P(GMPLFORM,U,2)_" form into "
|
|---|
| 23 | W:(42+$L($P(GMPLFORM,U,2))+$L($P(GMPLSLST,U,2))>80) !
|
|---|
| 24 | W $P(GMPLSLST,U,2)_" list ..."
|
|---|
| 25 | S (GSEQ,PSEQ,GMPLI)=0,GHDR="" S:'+GMPL(1) GHDR=$P(GMPL(1),U,2),GMPLI=1
|
|---|
| 26 | S GSEQ=GSEQ+1,GMPLGRP=$$NEWGRP(GMPLFORM,GHDR,GSEQ)
|
|---|
| 27 | F S GMPLI=$O(GMPL(GMPLI)) Q:GMPLI'>0 D
|
|---|
| 28 | . S ITEM=$G(GMPL(GMPLI)) Q:'$L(ITEM)
|
|---|
| 29 | . I '+ITEM D Q
|
|---|
| 30 | . . S GSEQ=GSEQ+1,PSEQ=0,GMPLGRP=$$NEWGRP(GMPLFORM,$P(ITEM,U,2),GSEQ)
|
|---|
| 31 | . S PSEQ=PSEQ+1,DIK="^GMPL(125.12,",ITEM=PSEQ_U_ITEM
|
|---|
| 32 | . D NEW^GMPLBLD2(DIK,+GMPLGRP,ITEM) W "."
|
|---|
| 33 | W " <done>"
|
|---|
| 34 | EXIT ; Clean-up
|
|---|
| 35 | K GMPL,GMPLSLST,GMPLGRP,GMPLI,GMPLFORM,GHDR,GSEQ,PSEQ,DIC,DIR,DIK,DR,X,Y,DIE,DA,DLAYGO
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | NEWGRP(FORM,HDR,SEQ) ; Create new group entries in #125.1 and #125.11
|
|---|
| 39 | N DIC,DD,DO,X,Y,DIK,ITEM,DLAYGO
|
|---|
| 40 | S DIC="^GMPL(125.11,",DIC(0)="L",DIC("DR")="1////"_DT,DLAYGO=125.11
|
|---|
| 41 | I $L(HDR),'$D(^GMPL(125.11,"B",$$UP^XLFSTR(HDR))) S X=$$UP^XLFSTR(HDR)
|
|---|
| 42 | E S X=$E($P(FORM,U,2),1,23-$L(SEQ))_" GROUP "_SEQ
|
|---|
| 43 | D FILE^DICN G:Y'>0 NGQ
|
|---|
| 44 | S DIK="^GMPL(125.1,",ITEM=SEQ_U_+Y_U_HDR_"^1"
|
|---|
| 45 | D NEW^GMPLBLD2(DIK,+GMPLSLST,ITEM)
|
|---|
| 46 | NGQ S Y=$P(Y,U,1,2)
|
|---|
| 47 | Q Y
|
|---|
